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TO 1U3 
SECTION I 


INTRODUCTION 


The F0RTRAN IV program described herein analyzes the nozzle for a hypersonic 
scramjet by a two dimensional second order characteristic procedure described 
in ATL TR 213, "A Source Flow Characteristic Technique for the Analysis of 
Scramjet Exhaust Flow Fields", Reference (1). 

The program starts from the initial profile and marches along down-running 
characteristics until the final X station is reached. This process can be 
interrupted by "Change of Origin Profiles" in source flow cases. Thi'-. Is 
done by interpolating the characteristic data at the required axial station 
and setting up "F arrays" i.e., XF, YF, ... . Then the program continues on 
down-running characteristics using the "F arrays" as an initial profile. The 
"F arrays" are computed for all flows at an X station that coincides with the 
cowl tip if there is a cowl in the flow field. If the flow is overexpanded 
at the cowl the program will invert the problem as described in Reference (l) 
When the shock reflects off the lower wall "F arrays" are again calculated 
and the computation continues with the problem Inverted until the final axial 
{X) station is attained. 


_1 
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SECTION I I 

DESCRIPTION OF INPUT 


A. Input 
Card 

Format 



Number 

Columns 

Format 

Description 

1 

1-5 

15 

Jl, type oT flow (O-two dimensional, 
1 -axi symmetric 


6-10 

15 

J2, coordinate exponent for line 
source system (O-two dimensional or 
axi symmetric, 1 -line source) 


11-15 

15 

NPTS , number of data points on Initial 
prof i le 


16-20 

15 

lEQ, chemistry indicator (O-frozen 
hydrogen-air chemistry, 1 -equilibrium 
chemistry) 


21-25 

15 

IC0WL, external data indicator (l- 
overexpansion or underexpansion inter- 
action calculations Is required, 0- 
i nternal flow only) . 


26-30 

15 

I0VER, overexpansion indicator (O- 
flow definitely underexpanded, 1 -flow 
overexpanded or marginal) 


31-35 

15 

MM, number of points in Prandtl -Meyer 
fan (MM=3, maximum) 


36-40 

15 

IDEAL, indicator for ideal gas calcula- 
tion, 1 -for calculation, 0 -non ideal 
gas 


1-5 

15 

KS IDE-si dewal 1 force and moment indicator 
0 -no sidewall calculation, 1 -for calcula- 
tion 


6-10 

15 

IVlS-viscous calculation indicator, 0- 
no calculation, l-vlscous forces and 
local heat transfer calculated 
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Card 


Number 

Columns 

Format 

Description 

2 

11-15 

15 

ITW-adiabatic wal 1 indicator, O-wall 
temperature must be specified if 
lV!S=l,(s& - card 17) 1-adiabatic wall 
calculation 

3 

1-10 

ElO.O 

*XBP, ratio of axial coordinate of 
cowl at initial station to throat 
height 


11-20 

E10.0 

XB0D, ratio of axial coordinate of 
lower wall at initial station to 
throat height 


21-30 

ElO.O 

XC0WL, ratio of axial coordinate of 
cowl trailing edge to throat height 


31-40 

ElO.O 

RTH, throat height (ft.), scaling 
parameter L* 


41-50 

ElO.O 

TEST, maximum allowable axial step 
size, used for computing upper bound- 
ary - typical value ==: .1 


51-60 

ElO.O 

XFINAL, ratio of final axial coordinate 
of run to throat height 


6-170 

ElO.O 

XTJi, ratio of axial coordinate of be- 
ginning of Cartesian region to throat 
height 

k 

1-10 

ElO.O 

XSHFT, ratio of axial coordinate of 
moment axis to throat height 


11-20 

ElO.O 

YSHFT, ratio of radial coordinate of 
moment axis to throat height 


21-30 

ElO.O 

XTHX, initial thrust (ibs/RTH^) 


31-40 

ElO.O 

YLFT, initial lift (Ibs/RTH^) 


41-50 

ElO.O 

XK0M, Initial pitching moment 
(ft-lbs/RTH3) 


*{A11 length variables are non-d i mens ionali zed by RTH.) 


- 3 - 


TM 183 


Card 

Number 

Col umns 

Format 


Description 

5 

1-10 

ElO.O 


XTHS, initial sidewall thrust (Ibs/RTH^) 


11-20 

ElO.O 


XLFTS, initial sidewall lift (Ibs/RTH^) 


21-30 

ElO.O 


XM|3MS, initial sidewall moment 
(ft-lbs/RTH^) 


31--40 

ElO.O 


XVTHX, initial viscous thrust (Ibs/RTH^) 


41-50 

ElO.O 


XVLFT, initial viscous lift (Ibs/RTH^) 


51-60 

ElO.O 


SVM0M, initial viscous moment 
(ft-lbs/RTH^) 

6 

1-5 

15 


NXXJl , number of locations in source 
flow where a new initial profile is 
desired, maximum is 4, minimum is 1 
{i.e. , changes of origin, cowl sta- 
tion, . . . ) 

7 

One of the following 
two-dimensional flow, 

cards 

card 

is necessary for each NXXJl. If 
7a may be blank. 

7a 

1-10 

ElO.O 


XXJ1, ratio of axial coordinate of new 
initial profile to throat height 


11-20 

ElO.O 


AXX, coefficients of polynomial de- 
scribing a segment of lateral extent 
of the nozzle 


21-30 

El 0 = 0 


BXX, for the equation (Z, == AXX{X-X,) 
+ BXX ^ ' 


31-40 

ElO.O 


X0R, ratio of axial coordinate of line 
source origin 

7b 

1-5 

15 


[FENCE, fence indicator (O-no fence; 
1-supersonic fence exists) 


11-20 

ElO.O 


AFENCE, coefficients of fence for the 
equation 


21-30 

ElO.O 


BFENCE, Y=AFENCE {X-XBP) + BFENCE 


-i}- 


Columns 

Format 

Description 

31-40 

ElO.O 

XFENCE, ratio of axial coordinate of 
fence on lower surface to throat 
radius 

1-5 

15 

NUWSEG, number of polynomial segments 
describing the cov*/l (maximum is 5) 

6-10 

15 

NLWSEG, number of polynomial segments 
describing the lower wall (maximum is 

5) 

of the 

fol lowing 

cards is necessary for each cowl segment. 

1-10 

ElO.O 

XXU(L), ratio of axial coordinate of 
beginning of "L^^" segment of cowl 
to throat height 

11-20 

E10.<^ 

t h 

A, coefficients of the "l'’ ” segment 

21-30 

ElO.O 

B, of polynomial describing cowl for 
the equation 

31-40 

ElO.O 

C, Y=AX^+BC+C; Y=Y/RTH & X=X/RTH 

One of the 
segment. 

fol lowing 

cards is necessary for each lower wall 

1-10 

ElO.O 

XXi,(L) , ratio of axial coordinate of 

* h 

beginning of the segment of 

lower wall to throat height 

11-20 

ElO.O 

t Pi 

A, coefficients of the "L *' segment 

21-30 

ElO.O 

B, of polynomial describing lower 
wall for the equation 

31-40 

ElO.O 

C, Y=AX^+BX+C: Y=Y/RTH & X=X/RTH 

1-10 

ElO.O 

EMIMF, free stream of reference Mach 
number 
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Card 


Number 

Columns 

Format 

Description 

11 

11-20 

ElO.O 

TIN, free stream or reference tem- 
perature (°k) 


21-30 

E10.0 

WINF, free stream or reference molec- 
ular weight ( Ibs/lb-mol e) 


31-'40 

ElO.O 

PINF, free stream or reference pres** 
sure (ibs/ft^) 

12 

Read this 

card i f IDEAL 

= 1 . 

12a 

1-10 

ElO.O 

GAMEY, ideal gas ratio of specific 
heats (y) 


n-20 

ElO.O 

XMWT, molecular weight 

13 

Initial Profile - One of the following cards are required for 
each data point as described below. The program reads data 
points beginning at the lower wall (point §^) and proceeds to 
the cowl (point #NPTS) . 

13a 

1-10 

ElO.O 

X(l), ratio of axial coordinate of 
data point to throat height 


11-20 

ElO.O 

Y(l), ratio of radial coordinate of 
data point to throat height 


21-30 

ElO.O 

P(l), ratio of pressure at data point 
to free stream pressure 


31“J^0 

« 

ElO.O 

0.(1), ratio of velocity at data point 
to free stream velocity 


41-50 

ElO.O 

T(1), ratio of temperature at data 
point to free stream temperature 


51-60 

ElO.O 

TH(l), flow inclination at data point 
(In radians) 


61-70 

ElO.O 

W(l), fuel to air equivalence ratio 


(only necessary if IEQ,=1) 
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Card 

Number Columns Format Description 


Initial Hass Fractions - Same as card 13 above except for 
mass fractions at each data point. These cards are 
necessary only if IEQ,=0. 


1-10 ElO.O mass fraction of H 


1-20 

ElO.O 

mass fraction of 0 

:i -30 

ElO.O 

mass fraction of H 2 O 

n-ko 

ElO.O 

mass fraction of 

n-50 

ElO.O 

mass fraction of 0^ 

o 

1 

ElO.O 

mass fraction of OH 

il -70 

ElO.O 

mass fraction of N 2 

This card 

is ncessary 

only if IC0WL =1 . 

1-10 

ElO.O 

*XM, axial location of cowl end 

11-20 

ElO.O ’ 

YM, vertical location of cowl end 

n-30 

ElO.O 

PM, ratio of pressure external to 
the cowl to free stream or refer- 
ence pressure 

}l-4o 

ElO.O 

Q.M, ratio of velocity external to 
the cowl to free stream or refer- 
ence velocity 

11-50 

ElO.O 

TM, ratio of temperature equal the 
cowl to free stream or reference 
temperature 

>l-60 

ElO.O 

THM, flow inclination external to 


the cov^/l (in radians) 


j1-70 


ElO.O 


WM, external flow molecular weight 
assumed the same WINF 
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Card 

Number 

Columns Format 

Description 

1 6 

This card necessary only if IVIS = 1. 



16a 

1-10 

E10.0 

XSTR, boundary layer virtual origin ! 


n-zo 

ElO.O ■ 

Pr, Prandtl number f 


21-30 

E10.0 

1 

Rec, boundary layer recovery factor 
(turbulent flov;) , 


31 “'-JO 

ElO.O 

REIN, free stream Reynolds number 5 

per foot 

: j 

' 

41-50 

ElO.O 

SH, constant for turbulent Reynolds ’ J 

analogy (ST = SH*C^/Z) 


17 Wall temperature d I stri butions-necessary only. 



If ITV = 

0, L = 1 Cowl 

surface; 

L = 2 


Vehicle 

surface; L = 3 

sidewal 1 


17a,b,c 

1-10 

ElO.O 

ah(l) 

coefficients in equations ^ j 


11-20 

ElO.O 

BH(L) 

%LL " AH(L)-(X-XBP)^ + BH(L)r 


21-30 

ElO.O 

ch(l) 

(X-XBP) + CH(L) i 
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FIGURE n\ Definition of Change of Origin Variables 
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SECTION in 

DESCRIPTION OF OUTPUT 

A. Output Format - The heading page contains program constants, line source 
coordinates and origin changes, upper and lower wall coordinates, free stream 
data at the cowl and infinity conditions. The program then prints the ‘'initial 
profile," the data at selected points along down-running characteristics in the 
flow field and the running liftj thrust, and pitching moment. The process con- 
tinues until the input value for the final axial location is reached. 

The above flow can be interrupted by "change of origin profiles" and a profile 
at the trailing edge of the cowl. If the flow is over-expanded at the cowl the 
output will switch to up-running characteristics from the lower wall to the con- 
tact surface and additional output covering the shock angle and external Kach 
number will be printed. When the shock reflects off the lower wall another pro- 
file will be printed and the run will proceed to the final axial location through 
down-running characteristics. 

B. identification of Output Variables 


X - axial distance/throat height 
Y - radial d i stance/throat height 
0. - velocity/f ree stream velocity 
T - tempera ture/f ree stream temperature 
P - pressure/f ree stream pressure 


TH 

- 

flow 

angle (radians) 

EM 

- 

Mach 

number 



ALP{1) 

= 

mass 

fraction 

of 

H 

ALP (Z) 

= 

mass 

fraction 

of 

0 

ALP (3) 

= 

mass 

fraction 

of 

H^O 

ALP (4) 

= 

mass 

fraction 

of 


ALP (5) 

= 

mass 

fraction 

of 

°Z 

ALP (6) 

= 

mass 

fraction 

of 

OH 

AlP(7) 

•-T 

mass 

f ract Ton 

of 

^2 
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Frozen flow extra output is: 

CPX - specific heat/freo stream specific heat 
W - molecular weight of mixture/free stream molecular weight 

Equilibrium flow extra output is: 

GAM - equilibrium isentropic exponent 
PHI - fuel to air ratio 

Vehicle Forces {thrust, lift, pitching moment): 

Vehicle force data are given at every output 
Station and ave delineated as follows 

(a) Cowl and undersurface forces 

(b) Sidewall forces 

(c) Viscous forces 
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SECTION IV 

SUBROUTINES AND FUNCTIONS 


A. Subroutines 
Name 


u 

INDATA 

2. 

COEFF 

^ * 

ERROR 

4- 

BODE 

5. 

BODU 


COWL 

7. 

COWLO 

8. 

DP0INT 

9. 

SHOCK 

10. 

SHOCPT 

11. 

PRM 

12. 

DRTEST 

13. 

ALL 

14. 

THERMO 

15. 

XMASSS 

16. 

FM 

17. 

PMf 

18. 

GEM 


Description 

reads and prints initial data and computes infinity conditions 

sets thermodynamic coefficients as functions of temperature 

prints program statement number nearest selected errors and 
terminates computer run 

locates axial and radial coordinates along lower vehicle surface 

locates axial and radial coordinates along upper cowl surface 

calculates shock Jump relations and Prandtl-Meyer fan at cowl 
trailing edge for under'-expanded flow 

computes contact points, shock paints and shock angle at cowl 
trailing edge for over-expanded flow 

computes location and properties of streamline intersection with 
characteristic (C.) 

calculates shock jump conditions 

computes shock angle by matching pressure from shock jump relations 
and pressure from characteristic relation on downstream side of shock 

computes isentropic ideal gas expansion 

tests for dropping data points on free str-aam side of shock 

calculates density, ratio of specific heats, Mach number, Mach 
angle, frozen flow specific heat, molecular weight and gas constant 

computes frozen flow specific heat, derivative of specific heat 
and enthalpy of each species from polynomial fits in temperature 

computes mass flow correction factor 

computes mass function 

computes flow properties for given Prandtl-Meyer turning 
computes intersection of two straight lines 
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Descript i on 


SL 

computes streamline properties of newly calculated data 

point 

iNT 

interpolation routine 


ERR 

finds roots of a given function 


FUZZY 

detects crossing of down~running characteristics 


WUZZY 

detects crossing of un-runnlng characteristics 


LTHM 

computes incremental lift, thrust, pitching moment and 
force 

s i de 

VIS 

computes viscosity coefficient 


SMRF 

canputes surface area unit normal and area centroid for 
mental surface quadri lateral s 

ele- 

GNURE 

computes flat plate skin friction and heat transfer co- 
efficients 


B0DL 

calculates body height and slope for vehicle surface given 
the axial location 

B0DU 

calculates body height and slope for cowl surface given 
axial location 

the 

Funct ions 

Description 


FT 

calculates temperature at any data point in flow field 


FH 

computes static enthalpy at any point in flow field . 


FGAM 

makes isentropic exponent and associated thermodynamic 
at any point in flow field 

data 

RHEd 

computes equilibrium density 


XMl 

calculates tan (9-ty) along up-running characteristic 


XM2 

calculates tan (9+y) along down-running characteristic 


XH3 

calculates tan (9) along streamline 
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Name 


Description 


8. FI or coefficient along up-running and down-running 

characteristics respectively 

g. FZ *A or coefficient along up-running and down-running 

characteristics respectively 


*Note: p - 0 relationship along up-running characteristic: 

^(PC-'’A) W'^2<>'c-V = ° 


p “ 0 relationship along down-running characteristic: 

B(P(.-Pb) - = 0 


-u- 
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SECTION V 


MACHINE CONTROL CONSIDERATIONS 


1. Machine - program designed for CDC 6600. 


2. Estimates for run. 


a. Field 

1 ength : 




(1) 

comp n e - 

65,000 

octal 

locations 

(2) 

load 

120,000 

octal 

locations 

(3) 

run 

100,000 

octal 

locations 


b. 


c. 

d. 


e. 


CP time: variable depending on number of points in 
initial profile and type of flow 

10: less than 100 octal seconds 

Tapes or disks used: 

(1) Tape 5 " card input 

(2) Tape 6 “ printed output 

(3) no other tapes or disk files used 

Printed output: as in CP time it is variable depending 
on case submitted. 
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SAMPLE INPUT FOR SOURCE FLOW 
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APPENDIX 
PROGRAM LISTING 


The following is a listing of the Fortran IV program for Source Flow 
Characterist i c 


- 17 “ 


PROGRAM NOZ BOD (INPUT ^QUTPUTj PUNCH, TAPE5=INPUTf TAPE6=0UTPUTr 

1 TAPE?=:PUNCH} 

COMMDNACQWL/ICOWLrMM,XM(93 ,YM(Q),PV1 ( 9) , WM (9 ] , RHM ( 9 ) , THM C 9 ) , QM C 9) , 
iRMC9) ,TMC9) ,GMC9 3 ,XMUM(9),EMM(9^ .• Al,PM C 7 , 9 3 , CPXM ( 9 3 

COMMON/.lPP/IPP 

COMMDN/.SHAPE/AAH5,23r AA2(5,2) ,AA3C5,2) ,XXU(5) ,XXL(53 , XINTU,XINTU 
COMMON/.LTM/XSHFT, YSHFT, XTHX, YLFT, XMDM.XTHS, YLFTS,XMUMS,KSIDE 
C0MM0N/.H0T/AH(33 ,CHt33 ,XSTR,PR,REC,REIN,RT,SK,ITW, IVIS 
COMMDN/.ViSF/XVTHXr YVLFT, XVMOM 

COMMON/.XXJ/NXXJl,XXJl C6) , AXX (6 3 , BXX (63 , XOR C63 

COMMON/^FINAL/XFINAL 

COMMON/, lEO/ lEQ, PIN, RHOINF,UINF,PINF 

COMMON/.VAR/RHO(200 3 r 

1EM(2003 , XMU(2003 /CPX(2OO3#^(20O3 ,RC2003 ,GAM(2003 ,XMASS(2003 , 

2 XNC2003 , YNC2003 ,QNC2003 , TN { 20 0 3 , PN (20 0 3 , THN ( 20 0 3 , RHON 
3(200), EMN(2003 ,XMUN (200 3 fCPXN (200 ),//N (200 3 ,RN (200 3 fGAMN (200 3 , 
4XMASSN(2003 , AUPNCiO,200) ,SIC103 ,HI (i0),TEMP(203 

5,ALPDUM(103 
COMMON /SP/ NSP 
COMMON/.FVAR/ 

1RHC3F(2003 ,CPXF(2003,EMF(2003 ,XMUF(200),wF(2003,RF(2003,GAMF(200), 
2XMASSFC2003, HF (200) , SF ( 200 3 , ALPD ( 1 0 3 , 

3TH£TA(203 

COMMON/ X/ XC2003, Y (200) ,P (2003, Q (2003, T (200) ,th ( 2003 , ALP (10, 200) 
COMMON /!/ lOPUT 
COMMON/.A/ TIN,CPIN,RD 
CDMMON/.B/ rtTMOLE 

■COMMON/P/ GAMINF,EMINF ,RINF,WINF 
C0MM0N/.F/A9,89,IB0D,XlvF,N8DD, VEND 

CDMMON/.ETX/XvJfXJl ,NPTS, IO,IREFL, ICHEM, IPUNCH, IDESGN, IR,NXX,XBP, 
lYBP,TH8Pf RAOrXBOD, YBaD,THBDD,RADB,XEND,THEND,RTH, YEXIT,THST,TEST, 
lIRFL, YO,RADB2,RRADC20) , NSTAR, YNDZ, EIN, PEN,H16,H17 
COMMQN/.XF/XF(2003,YF(200) ,PF (2003 ,QF (2003, TF (2003, THF (2003, ALPF( 
110 , 200 ) 

COMMON/.XCO^L/XCOWL 
COMMON/.C1/ EMC1,TC1,QC1 
COMMON /lOVER/ lOVER 
COMMON/.XTJ1/XTJ1 

COMMDN/fENCE/IFENCE,AFENCE,BFENCE,XFENCE 

COMMON/.ICMPLT/ICMPLT 

CDMM0N/.1CU/EMC2 

COMMON/fFF/PFINF 

dimension STSC2003 

DIMENSION NTMDLE(IO) 

COMMON/.DD/XD, YD,THD,PD,QD,RHD,RD,WD,EMD,GAM0,XMUD,TD 
DIMENSION TYPE2(23 
DIMENSION TYPE3C23 
DIMENSION TYPF.9(2),PHIPR(H) 

DATA PHIPR/3H ,3HPHI/ 
data TYPE9/3HCPX,3HPH1/ 

DATA TYPEi/iH W ,3HGAM/ 

data TYPE2 /lOH NOZZLE , 1 OHCENTERBODY/ 

DATA XXP/UE+06/ 

DATA ISHOC/-10000/ 

IDELG=0 
WRlTE(6f ^00) 

^100 FORMATCIHI) 


oooooooooor-. o 


JsQ '(tiO DIMENSIONAL 
-j*i axisymmetric 

SPECIES 1 IS H 

SPECIES 2 IS 0 

SPECIES 3 IS H20 

SPECIES ii IS H2 

SPECIES 5 IS 02 

SPECIES 6 IS GH 

SPECIES 7 IS fJ2 

SPECIES 8 IS C02 

SPECIES 9 IS CO 

SPECIES JO IS C3H8 

IPTPsO 

NXXJS2 

IFLIP=0 

IHALT=0 

ICMPLT=0 

NSTAR=0 

I0PUT=:32 

lUNDRsO 

IAA=1 

CALL INDATA 

XCOWLHsXCOWL 

IEQ5=IEQ+1 

YNOZsYBP 

PENS PIN 

XJ1SV=XJ1 

PFINF = PINF*2U6,/PIN 
IFENCJsO 
7211 IPP=0 
LSTT=0 

WRITEC6,400) 

IFCIFENCi .EQ,1) WRITE(6,3100) 

3100 FORMATC30X*FENCR INITIAL PROFILE*) 

IFCIFENCI. EQ.U GO TO 3101 
IFCIPTP.EQ.O ) WRITEC6,919i) XORU) 

9191 F0RMATC20X*INIT1AL PROFILE* 

1* ORIGIN OF SYSTEM =*E13.5) 

IFCIFLIP.EQ.O.AND.lPTP.EQ.l ,AND,XF CU.NE.XCDWLH) vYRITECS, 9192) 

1 XORCNXXJ-l) 

9192 FORMATCJSXACHANGE OF ORIGIN PROFILE* 

1* - ORIGIN OF SYSTEM =*El3,b) 

IFCIFLIP.EQ.O.AND.IPTP.EQ, l.ANO.XFCl ) .EQ.XCOrtLH) WRITE (6, 3132) 

I XORCNXXJ-’U 

3132 FQRMATC 8X*PR0FILE FOR UNDEREXPANOED SHOCK AT COWL* 

1* - ORIGIN OF SYSTEM =*E13,5) 

IFCiFLIP,EQ,l) WRIT£C6f600) XOR(NXXJ-l) 

600 FORMAT! 8X*PR0FILE FOR OVEREXPANDED SHOCK AT COWL*' 

I* - ORIGIN OF SYSTEM =*E13,5) 

IFCIFLIP,£Q.2) WRITE(6f621) XORCNXXJ*!) 

621 FORMAT! 6X*PR0FILE WHEN SHOCK REFLECTS OFF LOWER WALL* 

I* - ORIGIN OF SYSTEM 5*£13,5) 

3101 CONTINUE 
IEQl=IEQ+l 

WRITEC6/6396) PHIPRCIEQU 

6896 FORMAT! //5X,*PTt*f8 

1X,*X*, llXf *Y*f nXr*Q*, llX,*r*r llXr*P*r 10Xr*TH*10XA3) 


iraCHEM,eQ,0,AND,lEO,EQ.O) WRITE ( 6r 770 1 } 

7701 FDR(MATCl3A*rtURCUsH*ilX*ALP(2)=G^3X*AUP(3)=H20*?XAALPCiJ)=H2* 
13X*ALP(5)=02*3X*Al.Pt6)=0H*3X*ALPC7)=N2*) 

3160 CONTINUE 

00 3163 I=1»NPT5 

C=PF(I)/PliM 

yFPRsYF(I) 

THFPRsTHF(I) 

IFCIFLIP.EQ.n YFPR=-YFCI) 

IFCIFLiP.EQ.l) THFPR=-THFCn 
IF(IEQ.EQ.l) GO TO 9806 

rtRITEC6fl6) 1,XF(I) ,YFPR ^QF CD/TF CDrC ,THFPR 

WRITE(6» 1602) (ALPF C J, I ) f J= 1 / MSP) 

GO TO 3163 

9806 WRITEC6^16) I,XF(I) fYFPR ,QF CDrTF (I)rC rTHFPR,rtFCI) 

3163 continue 

1800 FQRMATC* UNDERSURFACE AND COWL THRUST =*E13 ,5f 7X*LIFT =*El3,5r7X*M 
lOMENT =*E13,5) 

XPTPsl 

XJlSVsXJl 

WRITE(6#3130) 

3130 FORi^ATC/) 

IF(KSIOE.EQ.O) GO TD 310a 
WRITE(6^ 1800) XTHX, YLFTfXMOM 
WRITEC6#3107)XTHS,YLFTS,XMOM3 

5107 F0RMAT(5X*S1DEWALL THRUST = *E12,«/5X*SIDEWALL HFT=*£12, 5X*SIDEW 
lALL MDMENT=*E12,4//) 

lFClVIS,EQ,nwRlTE(6»3i53)XVTHX,YVLFT,XVM0M 

3153 F0RMATC5X*VI3C0US THRUST =*E12.<^#5XaVISC 0US LIFT =*El2,a#5X*VlSC0U 
IS MOMENT -*E12,4//) 

3104 CONTINUE 
N=2 

umax=i 

KMAXs2*£N-l)-i 

IF(I0VER,NE,2) GO TO 7423 

N=3 

IPP = i 

LMAX=2 

KMAX=2 

7423 NNl=N-i 

DO 7424 I=:i,NNl 
IUNMl-I + 1 
DO 1500 J=1,NSP 
ALP£J,I)=Ai-PFCJ,II) 

1500 ALPDUM(J)=ALPCJf I) 

D=0, 

call INTCO, f XFCII),YFni) iTHFCII) rPFtll) rQFCIDiRHOFCIDfRFtn) ^ 
1WF(II),GAMF(I1) rEMFCII) f XMUF £11) rTFCII) f 

IDrDfOfD^DiOfDrO^DrDfDfO 

WX(I), YCI),‘fH£I),PCI)rQCl)iRHOCI)f RCI)»W(I)rGAM(n, 

1EM(I),XMUCI) rTCn^ALPDUM, IrlEQ) 

7424 CONTINUE 
500 CONTINUE 

IFCKMAX,GE,191) GO TD 9123 
6060 IPP=IPP+1 
6883 WRITEC6,7633) IPP 
7633 F0RMATC5X,*LINE NO, = *,I4) 


IF(IOVER,Ea,2,AND,KMAX.GE,103 GO TO 670 

JJ=l+KMftX/lO 

JJ1=KMAX-1 

IFCIO.EQ,!) JJ=1 

WRITE C6, 6885) TYPE3CIEQ5)rTyPE9CIEQ5) 

16 F0RMAT(3X^ I4,3X,J0E12.4) 

6885 FORMATCSXf *PT.*r8X,*X*, llX,*y*, llX,*P*f 10X,*TH*f 1 lX,*Q*r 1 IXf *T*» 
U0X,*E^*, 10X,A3 , 9XrA3) 

DO 7637 
CsPCI)/PlN 
YFPRsY CD 
THFPR=TH (I) 

DUPR=WCI) 

IF(IEQ5,EQ,2) DUPR=GAM(I) 
rPR=rp y f t i 

IF(IEQ.EQ,1)CPR=W(I) 

IFCIFLIP.EQ.U YFPR=-Y Cl) 

IFCIFLIP.EQpl) THFPRs-TH Cl) 

WRlTE(6f7632) I r X C I ) f YFPR/ C , THFPR, Q( I ) f T C I ) ^ EM C 1 ) # DUPR r CPR 
7632 FORMATC3X,ia,3X,10Ei2,4) 

7657 CONTINUE 

1602 FQRMATClOX, 10E12.4) 

IFCIPP.EQ.n GO TO 7759 

I=KMAX 

C=P(I)/,PIN 

YFPR=Y Cl) 

THFPRsTH Cl) 

DUPR=WCU 

IFCI£Q5,EQ,2) DUPR=GAMCI) 

CPRsCPXCl) 

IF(IEQ,EQ,1)CPR=WCI) 

IFCIFLIP.EQ, 1) YFPR=-Y Cl) 

IFCIFLIP.EQ.I) THFPR=-TH (I) 

WRITEC6,7632) I , X C I ) f YFPR, C , THFPR, QC I) r T C 1 ) ^ EMC I ) , DUPR , CPR 

GO TO 7759 

670 JJ=1+KMAX/10 
JJ2=1 
ISH=ISHOC 
JJUISHi-l 

WRITE C6, 6885) TYPE3CIEQ5) 

672 00 671 I=J02,JJ1,JJ 
CsPCI)/.PIN 
YFPR=Y Cl) 

THFPRsTH (I) 

DUPR=WCI) 

IF(IEG5,EQ,2) DUPR=GAMCI) 

CPK=CPXCI) 

IFCIEQ.ED. nCPRsWCl) 

IFCIFLIP.EQ.I) YFPR=-Y Cl) 

IFClFLIP.EQ.n THFPR=-TH Cl) 

WRITEC6/7632) 5 , X C I ) r YFPR, C , THFPR, QCI ) , T C I ) f EM( I ) , DUPR ,CPR 

671 CONTINUE 
i=JJi+l 

C = PC1)/.PIN 
YFPRsY Cl) 

THFPRsTH Cl) 

DUPR=WCI) 


IFaEQS,EQ,2) DUPRsGAMCI) 

CPRsCPXCiJ 

IF(IEQ„EQ, nCPRsWCI) 

IFaFLIP.EQ, 1) YFPRs-^Y Cl) 

IF(IFLJP*EQ,U THFPR=-TH (I) 

WRiTECbr 7632) I , X C I 3 ^ YFPRf C ^ THPPR,Q(I) f TCI) »EMCIJ fDUPR,CPR 

1FCJJ1,EQ,KMAX-1) go to 7759 

JJ231SH+1 

JJUKMAX**! 

GO TO 672 
7759 BETPRsQET 

WRITEC6» 1800) XTHX, YLFT,XMOM 
IFCKSlDE.EQ.l) 

1WRITE(6/310 7)XTHS? YLFTS.-KMOMS 
1F(IVIS,EQ,1)WRITEC6,3153)XVTHX,YVUFT,XVM0M 
IFCIFLIP.EQ. 1) BETPR=-BET 
IF(IOVER*EQ,2) WRITEC6,653) BETPR,EMC1 
653 F0RMATC5X*SH0CK ANGLE 1 2 , 4 , 5X*EXTERNAL MACH NO, =*£12,4) 

IFCIUNDR.EQ, 1)I^RITE(6,59 6)EMC1 
596 F0RMATC5X* EXTERNAL MACH NO, = *E12,4) 

WRITEC6/ 1603) 

1603 FORMATC///) 

6884 ICMP=1CMPLT+1 

IF(IOVER.NE,2) GO TO 2658 
ISHOC=ISHOC+l 

IF(NSTAR,EQ,1) ISH0C=ISHQC-2 
2658 CONTINUE 

IFaHALT,EQ,l) STOP 
IFaFLIP,EQ,2,AND,N,GT,NPTS) STOP 
GO TO C4300»430l#4302, 4303) , ICMP 

4301 IF(ICO/slU*EQ,0) STOP 
ICMPLT=2 

lUNDRsl 

CALL COrtLC-l,) 

IPM=l 

4302 IPM=IPM+l 
IF(IPM.GT,MM-5)ICMPLT=0 
IF(IPM,GT,MM^3)G0 to 8104 
LMAX=KMAX+l 

DO 4306 J=1,NSP 
ALPNCJf U=ALPMC J, IPM) 

4306 ALPDUMCJ)=ALPM( J, IPM) 

0=0, 

CALL 1NTC0,,XM(IPM) , YMCIPM) ,THMCIpvi) ,PMCIPM) ,QM(IPM),RHMCIPM) 
IRM(IPM) , WMCIPM5,GM(IPM),EMM(IPM),XMUM(IPM),TH(IPM) , 

10,0,0,0, D,0,D,D,D,D,D,D 

1,XNU) , YNU ) ,THNC1 ) ,PN(1) ,QNCi) ,RHPNCl),RNCl),WNCi ),GAMNU) , 
lEMNCi) ,XMUNCU,TN{1),ALPOUM,0, lEO) 

GO TO 8060 

4303 ICMPUT=3 
STOP 

4300 iFCXa ) ,EQ,XC0SNLH,AND,IPP,EQ,NPTS,AND,IDVER,NE,2) go TO 4301 
If CN.GT.NPTS) GO TO 6104 
LMAX=LMAX+2 
L=1 



DO 510 J=WNSP 
ALPNCJ^LJ=ALPFCJf^) 

510 ALPDUMt J)=ALPr(J,N) 

call IMT CO,,XF(ND,YF(N)rTHFCN3,PF£N),QFCN},RHOFCN),RFCND, 
IWF(NJ,GAMFCN)»EMFCN),XMUFCW)mF(N), 

IDpDrCfDrOf DfDfDfD^D/DfD 

WXN£L) ^ YNCL3 ,THNCL),PN(L5 fOWCU #RHONCU f RNCL3 ,WN£L) rGAMNCL) f 
lEMN(L),XMUNCL3fTN(UrALP0UM,if ItQ) 

IFENC151 

IFCIFENCE.EQ.I.AND.XNCU ,EQ,XCDWLH,AND,N,EQ,NPTS) go to 2601 
IFENCI=0 
60 TO 8060 
810a ASL=TANfTHCn3 

ACH=TANCTH£2)+XMUC23 3 
THSLsTHCn 

CALL GEMCX£2),Y(2) ,ACH, X C 1) r V C 1 3 , ASL , XN C 1) , YDUM) 
DELTK=XNU3-XU) 

IFCCDELTH/TEST).GT.1,3 go to 9061 

iT=i 

lERsO 

IFCIUN0R,GT.03G0 TO 9060 

call BODU£XC13fY(i3rTH(n,XC23fY(2),ACH,XN(13rYDUM ,THN(133 
THSL=THNa) 

IFfIOVER,NE,23 GO TO 69^1 
YNtl3=-YNCl3 
THN(1)=-THNC13 
69a CONTINUE 

DELTHsABSCTHNiD-THtn) 
lF(OELTHpGT,THST3GD TO 9061 
D£LTH = XNC13'*xa) 

IF(CDELrH/TEST3,LT,1.3 GO TO 9060 
9061 LMAX=KMAX+1 

DO 9000 M1=2,KMAX 

LbKMAX-MI+2 

iBL+i 

DbO, 

DO 9001 J=lfNSP 
ALPCJ,I3=ALPCJfL) 

9001 ALPDU^C J)=ALP(J,L) 

CALL INT£0*fX£L3 rYCUf THCL3 ,PCL) ,Qa)/RHDa),RCL),WCL)»GAMCL3, 
lEMCL3rX^1UCL3,T(L), 

IDrDfDfD/DrDfO#DfD#D/DpD 

l#XCnrY(I3,THCI3,P(I3,QCI)fRHOCI3fR(I)f WCnfGAM<n,EM(I3, 

IXMUCI3 , TCI3 r ALPDUMf 0, IEQ3 
9000 CONTINUE 

ISHOC=ISHOC+i 
KMAX=KV)AX+1 
RATS, 5 

DO 9003 jBlfNSP 

ALP£J,H3=ALPCJ, n+RAT*CALPCJf 33-ALPCJf 13) 

9003 ALPDUMCJ3=ALP£JfH) 

CALL INTCRAT,X(n,yCl),THC13,P(13fOCl>#RHOCi),RCl)fWCnfGAM(i), 
lEMCn rX'^UC13,TCn,XC3),Y(3),THC33 ,PC33,aC3),RHDC3),R(5),w£3), 
1GAM£53 rEMC3),XMU(3),Tf3),XC23,Y£2) ,TH£23,PC2),QC23fRHDC23 f RC23? 
lW(2),GAMC2J,EM(2),XMUC23,TC23,ALPDUMr IEQ3 
GO TO 8ioa 
9060 LMAXbKMAX 


B-O, . - 

IFtlSHOC.EQcU BETNsBET 

8000 

IT = i 
lERaO 

IFCB.EQ.O) THN(13=THSL 
8030 EMSLsXM3C,5r . 5 , TH C 13 r T HN C 11) 

£Ml=XMi (A,B,THC2 3f XMU(23,THNCn f XMUNU3 3 
IFCISHOC.EQ.I) EM1=,5*(TANCBET3+TANCBETN3 3 
CALL GEMCX(2)fY(23 ,EM1 , X ( 1) , Y t 1) / EMSL, XM C 1 ) , YN C 1 3 ) 
IFaUNDR,GT,0)GOT 0 8020 

CALL BPDUCXC13 f YU )f THC13 iX(H3» YC23/EM1 ,XNC13 f YNCn r THNU3 3 
THSLsTHNCn 

XFCIOVERsNE-2) GO TP 698 
YNC13 = -YiMU3 
THNCl}=-THNCi) 

698 continue 

8020 AlsPl (A,B, XMU(23,GAf^(2) ,PC23 » XMUNCn f GAMNC13 f PNU 3 3 
XDUM2=XC23-xaR(NXXJ-13 
XDUMNsXNU3^XaR(NXXJ-l 3 

A2=F2(A,Br l.f XJ,XJlfXDUM2,YC23 rTHC23 ?XMUCH3 f XDUMN, YNC13 f THNU3 ,XMU 

1NU)3 

DUMlsA2*CXNCl3-XC23 3 

IF(XJl.GT,0,3 DUM1=A2*AL0GCXDUMN/XDUM23 
DUM= CTH[23-THN(13-DUMi3/Al 

PNU3 = PC23*EXPCDUM3 
IF(IUNDR,EQ.O)GO TO 1801 
P2SPNC13/PC13 

CALL PR^lCP2rTHCl 3 rEMCl rTH2T,EMC2r-I 3 
ERiisTH2T-THN(l) 

IFCABSCER4) ,LT,1 .F-0«)GD TO 1801 
CALL ERRCIERrIT.THNU) ,ER4, l,Ol,THNl,ERn 
IFCIER,EQ,0)GO TO 73 
WRlTE(6r 173 

17 FORMATClXf* TOO MANY ITERATIONS IN BDDU CONTACT *3 
STOP 

75 IT=IT+1 
GO TO 8030 
1801 continue 

DO 8050 Jai/NSP 
ALPIMCJ, 13=ALPCJf 13 
8050 ALPDUM€J)=ALPN(J,13 

call SL(P(l)#Q(n?RHOCi3/Rn)»W(13»GAMU3>EM(n,XMUU)iT(13r 
lPN(n,QNC13^RHaNC13rRNU3fWN(l)fGAMN(13fEMNC13f XMUNCDf TNC13? 
lALPDUM, IEQ,A,B) 

IF(B.E3.0,,OR,IUNDR,EQ,1 3GO TO 1798 
IFCXNC 1 ),GT,XCDWL«1 ,E-0«3 GO TO 1798 
IFCXNC 1) ,GT.XXJ1 CNXXJ3-UE-043 GO TO 1798 
C *****CDMPUTE COWL AND SIDEWALL FORCES ***********C 
ZUAXXCNXXJ-13*{X (15-X8P3+BXX(NXXJ-n 
Z2 = AXXCNXXJ''13*(XN(13-XBP3+BXX(NXXJ"n 

CALL LTHMt XC13,YCnrZl,XU),YCl5,'*ZlrXNU3»YNU}r-Z2#XNU3, 
lYNCn rZ2fPC13rPCl3 f PNU3 rPNCn ?a(i) ,Q(13f QNCUf ONC13 7RHD( 13 , 
2RHOCi3,RHONtl3,RHONCl),RCUfRU3,RNC13f RNCl)/WCn#W(i)fWNU3f 
3WN (13^THCl3fTHCl),THN(13#THNC13f ALPDUMf , 25 ? , 25 r , 25 , . 25 ? 
4XTHX#YLFT»XMQM,CF,ST/ 13 



STUsST 

jfcksice:,e;q,o)go to i?98 

Zil = AXX(NXXJ-n*CXC2)-XBP)‘i'BXX(NXXJ«l) 

DQ a05l J=lrNSP 

2031 ALFDUM(J3=CALPCJ,1)+ALPCJ, 2)3/2, 

CALL LTHMCXCl),Y£U,Zi,XN(i)iYN(l)rZ2rXNa3,YWa3 ,22,XC2)^YC2), 
iza,pcn ^PNCU,PNC 1 ),PC 2 ) ^«(13 jSNCn,QNCn^Q(2)^RH0(l) rRHONCn f 

2RH0NC1) f RHOC23 ,RCI),RNC1) ,RM(1) ,RC2) rWCl ) ,yvNa)i WNCIJ ,W(2) , 

3TH £ n, THNU ),THNC1),TH (2), ALPDUM,. 33333,. 35533,0,, .33333, 

4XTHS, YLFTS,XMOMS,CF,ST,33 
STSC1)=ST 

1798 IF(8,GT,0.) GO TO 8049 
As.S 
B:=,5 

GO TO 8000 

8049 IFCISHOC.NE.l) GO TO 2600 

CALL SH0CPT'(ISH0C,3,B£T,BETN, A,B) 

BET5THN t 23 -CBETM-THW Cl) ) 

IGG=i 

2625 CALL SHOCK CBET, ON C2) , THN (2) , GAMN (2) , EMN (2 ) , RHONC2) , PM £ 2) , WN (2) , 
1RN(2),QN£1) ,TH2,GAMN(i) ,LMN£1),RH0N(1 ),PNC1),IVNC1),RN(1),TNC1), 
IXMUNCi),-! ,) 

ER4sTHM(1)*TH2 

IF£ABSC£R4),LT,1,E-04) GO TO 2601 
IG6=IGG+1 

IFCIGG.GT, 15) GO TO 2627 

IF(IGG,GT,2) GO TO 2628 

ER1=ER4 

BETP=BET 

B£T=BET+,02 

GO TO 2625 

2627 ^RITEC6,2629) 

2629 FOHMATC* ERROR IN BETA LOOP IN MAIN*) . 

STOP 

2628 DUHM=BETP-’£P4*(BET'*BETP)/CER4-ERI) 

ERi=ER4 

BETP=BET 
B£T=DUMM 
GO TO 2625 
2600 CONTINUE 

IF(IFHP,EQ,l.AND,XNf D.GT.XFINAL) IHALT=1 

IF(XNCi) ,LE.XCOWL-1.E-04,AND,XN( U.LE.XXJl CNXXJ)-l,E-04) GOTO 8060 
XNNsXCOrtL 

IFCXNCU .GTtXXJl CNXXJ)-1 .E-04) XNN=XXJ1 CNXXJ) 

RATsCXNN -*XC1) )/CXN(l)-XCn ) 

DO 3519 J=1,NSP 
ALPNCJ, 1 )=ALPCJ, 1 ) 

3519 ALPDUMCJ)=ALP(J,1) 

CALL INTCRATfXCn, YCl),THCl),P(l)rQ(l),RHO£l) rRCDflNCn ,GAM(1) , 
i EMCn,XMU(l),TCU, 

iXNCl),YN(l) ,THN(1),PNC1) ,QNCl),RHONCl)rRNCl) rWNCU rGAMNCl) , 
iEMNCl),XMUNa),TN(l), 

iXNCn,YN(l),THN(l),PNCl),ON(l),RHONCn,RNCn,WNa) ,GAMNC1) , 
lEMNCn rXMUNU),TNU ) , ALPDUM, 1 , lEQ) 

XNU)sXNN 

XZsXNCD-XINTU 

L6=5 


ZFCXZ,UT,X5<U(5))L6=f* 

IF{XZ,l.T*XXU('n )L6=3 
IF(XZ,lT.XXUC3nL6=2 
IFCXZ.lt, XXU( 2m6 = l 

YNU) = AAiab» n*XZ*XZ + AA2a.6f n*XZ+AA3CL6, n 
THNCnsATAiMC2,*AAi (U6f n*XZ+AA2a6, 1) ) 

C *****COMPUTE COiNL AND SIDEWALL FORCES ***********C 
zi=Axx(Nxxj-n*cx cn-xapj+BxxciMxxj-u 
zasAxxcNXXj-n^cxNcu-xapj+BxxcNxxj-sn 

CALL LTHMC X C 1) » Y ( 1 ) , Z 1 , X ( J) f Y C 1) / -Z i , XN C 1) f YN (1 ) , «Z2 , XN ( n , 

lYNCn rZ2,PCl),PCl)rPMCl ),PNCn,Q(l) rQ(l)/Q^JCnfQf^Cl) f RHOCl) r 
2RHDCn ,RHON( 1) ,RHON(l) ,RC1) fR(l) rRNCn f RIMC i) ^WCUfWCn fWNCl)/ 
3WNCt)f THU),THCn ,THNCn ,THN(1},ALPDUM, ,25, ,25f ,25, ,25, 

4XTHX, ylft.xmom,cf,st, n 

5TU=ST 

IFCKSID£,EQ,0)GD TO 260J 
ZasAXXCNXXJ--n*CXC2)-X8P3+BXX(WXXJ-n 
00 2033 J=l,NSP 

2033 ALPDUMC J) = (ALP(J, 1 )+ALPCJ,23 3/2, 

call LTHNUXCl) ,Y(U, Z1 fXNCn ,YNC13,Z2,XNC13, YNCl 3/Z2,XC2),Y(23, 
IZA,PC1 3 , '’N(13 ,PN(13 ,P(23 ,Qtn,QN(13 ,QNC13 ,«C23 ,RH0C1 ) rRHONCn , 
2RHONC13 ,RHOC2) ,RCn ,RNC1 3 iRNCn ,RCH3 ,WC13 ,v.NCl 3 ,WNC13 , WC23 , 
3TH(n ,THNC1) ,THNC 13 ,THC 2), ALPDUM, ,33333, .33333,0., .,33333, 
aXTHS,YUFTS,XMOM5, CF,ST,33 
3TSCI 3=ST 
2601 CONTINUE 
ICMPLT=1 

IFCXNC13 •EQ,XCOwi3XCaWL=l .E+06 
IFUOELG.EQ.n GO TO 2622 
IFCXJl ,EQ,0. ,AN0,IOVER.EQ,03 GO TO 8060 
2622 CONTINUE 
IXrl 

IFUFLXP.EQ,!) IX=2 

2655 lAAsIAA+1 
D^O, 

DO 3470 J=l,NSP 
ALPDUMC J3=ALPN(J,IX3 
3470 ALPFCJ,IAA3=ALPNCJ, 1X3 

CALL INTCO,,XW(lX3,YNax3,THNCIX3,PNaX3,QNax3,RHONClX3, 
IRNCIX) ,NN(IX),GAMNax3,EMMCIX),XMUNCIX3 ,TNCIX3 , 

1 0 , D , D , D , 0 , D , D , D , D , D , D , D , 

1XFCIAA3 ,YFCIAA),THFC1AA3 ,PF(IAA3 ,QF(IAA3 fRHOFCIAA) ,RFC1AA) , 
iWF(IAA),G*'wraAA3 ,EMFCIAA3 ,XMUF(IAA3 ,TF (lAA), ALPOUM,0, IEQ3 
IFCIX.EQ.n GO TO 2656 
1X=1 

GO TO 2655 

2656 IFCIFLIP.EQ, 1) IAA=IAA-1 
ICMPLT=0 

NSTARsO 

IFCXNa3 + ,OOOl,G£,XTU13 XJ1 = 0, 

IFCIFLIP.NE.I 3 NXXJ=NXXJ+1 

IF(IFENCl,EQ,n IFENCEsO 
IF(NXXJ,GT,NXXJ13 NXXJ=NXXJl+l 
IFaFLIP.GT.O) GO TC3 2602 
IF CICDWL.EQ.O) go to 7593 
RP=PM (MM3/PF(IAA3*PIN 
IFCRP.GT,!,) GO TO 5989 


7593 NPTSsIAA 
lOVERsO 
1AA=1 

SO TO 7211 
5989 CONTINUE 

EMEXT=EMINF*QM(MM)/SGRTCTNKMM)) 

CAUL COrtLOCIAA,THM(MM) ,EMEXT,BETf PM (MM)3 

XINTU=XINTL 

DO 691 Il3sl,5 

XXU(I13)=XXLCU3) 

AAl(I13f 1)=AAHI13,2) 

AAacm,lJ=AA2Cn3/23 
691 AA3(Il3f 1)=AA3(I13,2D 
2602 CONTINUE 

NPTS=IAA+i 
IFLIP=IFLIP+1 
IFaFLIP.GT.l) XXPsXFINAL 
lAAsl 
L3TT=0 
10VER=2 
CALL INOATA 
BET=-BET 
ISHOC=l 
GO TO 7211 
8060 CONTINUE 
LM=LMAX-1 

IF(ID£LG,ES,1 .and, IAA,GT,1) LMslOOO 
iFCXJt . gt,o,,ano,iaa.gt, n lm=iooo 
IFCIOVER.EQ, 2,ANO,LSTT,EQ,n LM=1000 
L5T = 0 
LTHsl 

IF(NSTAR,£Q,03UTH=0 
L=i 
M = 0 

IDPT=0 

LWUZ^IOOO 

XXPsXFINAL 

ifcnstar.eq, n m=2 

IF(ICMPLT,E0,2) M=1 

c ******* compute sidewall FORCES ***************** C 
5520 IF(KSIDE,EQ.O,OR.L*EO, UGO TO 5521 
NM=M-l 
LTH=LTHtl 
IFCM,EQ.l)NM=l 

Z1=AXXCNXXJ-1)*(X (NM)-XBPJ+BXX(NXXJ-n 
Z2=AXX(NXXJ-13*(XNCK )-XHP)+BXXCNXXj-n 
Z3=AXXCNXXJ-l)*tXNCL ) -XBP ) +BXX C NXX J- 13 
Zq = AXXCNXXJ-n*fX CM )-XBP3+BXXCMXXJ-n 
XKi=,25 $XK2=,25 $XK3s,25 $XK«=,H5 
IFCM.GT.UGO TO 663 

XK1=, 33333 $XK2=, 33333 $XK3=, 33333 $XKa=0, 

603 CONTINUE 

DO 687 J=lfNSP 

687 ALPOLIMC J)=XKl*ALPCJf NM)+ALPN( J,K3*XK2+XK3*ALPNCJf L)+XKa*ALP( Jf M3 
CALL LTHMCXCNM) rY(NM),ZliXNCK3fYN(K3 ,Z2,XN(U3 , yWCL3 rZ3/XCM3 ,Y(M3 r 
iZA#PCNM3,PN(K3 f PNCL3#P(M3 ,QCNM3 f QN{K5;QNCL)#S(M3 /RH0CNM3,HH0N(K3 r 
2RHONCL3 ^RHO(M3f RCNM3,RNCK),RN(L3 ,RCM) ,WCNH3fYVN(K3 ,WNCL)f WCM)f 



3THCNM),THN(K),THN(Uf TH(M) ,ALPDUM,XK1 ( XK2» XK3rXK4, 

4XTH5f VLFTS, XM0MS,CF,ST,3} 

STS(UTH)=ST 

IF(L.£Q,LMAX)GO TO 265 
5521 L=L+1 

IFCL.GT.LM) GO TO 6520 
K"U"1 
678 M=M+1 
A=l, 

£■ Q 

CALL FUZZY(K,L,M,N,LMAX,KMAX,NPTS,IPP,IFZ) 

IFCIFZ.GT.OJGO TO 265 
250 CONTINUE 

IFCL,EO,ISHOC+1) CALL SHUCPT CISHDC , M, BET , BETN , A, B) 
IFCL.NE,ISHOC+l,OR,8,EG,0,,QR,IFLIP,N£.n GO TO 2603 
IPL = 3 

268a P0LYC = -^AA3tIPL, 1 )-YNCU + TANCBETN)*(XN(L5-XINTU) 

P0LYB=-AA2CIPLf 1)-TAMCBETM) 

POLYA=-AAl (IPL, 1) 

IF(POLYA,NE,0.) 

IXXP =C-POLYB-SQRTCPOLYB*POLYB-a,*PaLYA*POLYC) )/C2,i»rPOLYA3 
IF(P0LYA,EO,0, ) XXP =-POLYC/POLYB 
XXP =XXP +XINTU 

IFCXXP ,GE,XXU(IPL)) GO TO 2603 
IPLsIPL-^1 
GO TO 266a 
2603 CONTINUE 

IFCL*EQ,ISHOC+n GO TO 3003 
EMl=XMl(Ar0, THCM3 ,XMUCM),THNCL),XMUN(U) 

EM9=EMi 

IF(L,EQ,ISH0C3 E^A1=TAN CBET) 

IF(L,EQ, ISH0C,AND,M,GT, UEMlaTANCBET + THNtL-n+XMUNCL-n-'THCM-i) 
l-XMUCM-13 ) 

EM2=XM2CA,B, THN(K), XMUN(K3f THNCU rXMUNCU ) 

XNCL3 = (YNCK)-’YCM)+EM1*X (M)-EM2*XN(K) 3/{EMl'-EM2) 

YNCL) = YCM)+EM1*(XN(U-XCM)) 

IFCB.GT.O,} GO TO 681 

IORQP=0 

BETT=BET 

IF(M,GT, 1 ,AND,IOVER.EQ,2)BETT=BET+THNCL-n tXMUN(L"i )-TH(M-l)-XMUCM 

IFCL,£Q,I8H0C-n CALL DRTEST ( XN (L ) , YN CL D , EMI , BETT , IDROP, + 1 , M) 

IFCL.EQ^ISHOC+E) CALL DRTEST (XN CL) / YN CL) , EMI , BETN, IDRDP, "1 , M) 

IF(IDROP,EQ,0) GO TO 681 

LMAX=LMAX"1 

LM=LM-l 

IFCL.LT.ISHOC) ISHOC=ISHOC^i 
GO TO 678 
681 CONTINUE 

IFCL.NE.ISHOC) GO TO 601 
YSHDCsYCM) 

XSHOC=XCM) 

IFCL.GT.2) GO TO 602 
YDUM=YNa)*EM9*CXWCL)-XCM)) 

XDUM?X(M) 

RAT=CY0UM-YCM))/CYNC n-YCM)) 

D-0. 


DO 64« J=1,NSP 

AUP(J,M)=AL.PCJrM)+FIATA (AUFNt J,i>ALP{ J,M)3 
644 ALPDUMC J)=:ALP(J,M) 

CALL I N T ( R A T , D , D , TH C M ) , P C M3 , Q ' N' :■ I RHO C M 3 , R C M) , W C M ) , G AM-CMr) , 
lEM(M) ,KMUCM),T(M3,D,DrTHNn) rPNCl),QNCl),RHDNCl) ,RNC1) f 
IGAMNEl) ,£MNCl3f XMUNC 1) , TM C 1 3 r D/ D , TH (M) , P (M3 , Q CM) ^ RHO ( M ) , R (M) , 
iWCM)rGAM(M) ,EM(M) ,XMU(M3 ,TCM), ALPDUM, 1, IEH3 
60 TO 601 
60a CONTINUE 

EM8 = XMaC .5, .5,THCM-n rXMU(M..n, TH(M3 ,XMUCM3 3 
YDUM=(EM9*Y(M3-EM8*YNCL)+EM6*EM9*(XN(L)-X(M3 3 3 /CEM9-EM8) 
XDUMsXNCL)"CYN(L3-YDUM)/EM9 
RAT=CYDUM-YCM33/CY(M^1)-Y(M3 ) 

D=0, 

DO 604 J=1,NSP 

ALPCJ,M3=ALPCJ,M3+RAT*CALPCJrM-13-ALPCJ,M)3 
604 ALPDUMCJ3-ALP(J,M3 

CALL INTCRAT,Df D,THCM) ,PCM3,Q(M3 »RHQ(M3 ,R(M),W(M3 #GAMCM) , 

1EM(M3 ,XMU(M3 ,T(M) ,0,D,THCM-13 ,PCM-n f QCM-U rRHOCM-»13,R(M-l3 , 
lWCM-^1) /GAM(M-13,EM(M-1) ,XMUCM-13 ,T(M-n,D,D, THCM) ,P(M3,QCM3 
IRHOCM) ,R(M3 /N(M),GAMCM) ,EM(M3 ,XHU(M3 , T (M) , ALPDUM, 1 , I EQ 3 
601 CONTINUE 

A1=F1 (A,B, XMUCM)#GAM(M) ,P(M3 ,XMUN(U rCAMNCU #PNCU3 
BUFl (A,B, XMUN(K),GAMN(K3 #PNCK), XMUNCL3»GAMN(L3 f PNCU 3 
XDUMK::XNCK)"XOPCNXXJ-l 3 
XDUMM = X(M3-XORCNXXJ-n 
XDUML = XN(U-XORCNXXJ-l ) 

A2=F2(A,B, i.,Xj,XJl rXDUMM,YCM3,TH(M3 ,XMU(H),XDUML,YNCL),THN(L3iXMU 
IN(L)3 

BasF2(Af B,-1,,XJ,XJ1 ,XDUMK,YN(K) ,THN(K3fXMUN(K3f XDUMLrYNCU ,THN(L3 
1#XMUNCL3 3 

DUMis-CAE + B23*XNCL3 + A2*X CM)+B2*XNCK) 

IF(XJ1,GT,0, 3DUM1=-CA2*AL0GCX0UML/XDUMM)+B2*ALDGCXDUML/XDUMK3 3 

DUM =CA1*AL0G(PCM3 3+B1*AL0GCPNCK3 3+TH(M)-THN(K3+DUMi 3/(Al ten 

PN(L)=EXPCDUM3 

DUM=AL0GCPCM)/PNCU 3*A1 

DUM2=XNCL)"XCM) 

IFCXJl ,N£,0,) DUMasALOGCXDUML/XDUMM) 

THNCL3=DUM+THCM3-A2*DUM2 
253 CONTINUE 

CALL DPOINTCK,L,M,N,NPTS, A,B) 

CALL SLCPD# QD,RHD,RD,WD,GAMDf EMD^XMUD, TD , PN C U r QN C L ) r RHON ( L 3 f 
IRNCU rV^NCU ,GAMNCL3^EMNCL3f XMUNtU # TN (L) , ALPOUM» I EQ r A , B) 

DO 1502 J=l,NSP 
1502 ALPN(J,L)=;ALPDUMCJ3 
3003 CONTINUE 

IF C10PT,EQ,0) GO TO 8400 
IFCe,GT,0,3 GO TO 8401 
A=,5 
B=,5 

GO TO 253 
8400 continue 

IFCB,GT,0,3 GO TO7520 
IFCL,N£,ISH0C) GO TO 606 
IFCL.GT.B) GO TO 650 
RATsCYNC 13-YSH0C3/CYN( 1)-Y(M33 
Y(M)=YSHOC 



XCM)»XSHDC 

0 = 0 , 

DO 655 J=1,MSP 

ALP(J,M)=ALP(J,M)+RAT*(ALPNCJ,1 J-ALPUrM)) 

655 AUPDUM(J)=AUPCJ,rft) 

CAU I\TCRAT,D,D^TH(M) ,P(M),Q(M),RHO(M),R(M) ,W(M) ,GA^ICMJ , 
iEM(M) rTCM) ,D,D,THM(1) ,PN(t 3 #QNC1 ) rPHONU) f RNCi )^‘vNU5 , 

IGAMNCl 3 ;EMNC13 ,XMUN(1 3 rTN(l),D,D,TH(M),P(M) ,a(M) rRHO(M3,R(M) , 
iWCM3fGAM(M),EM(M),XMU(M),T(M),ALPDUM,UIEQ) 

GO TO 606 
650 continue 

RATsCYCM-D-YSHDO/CYCW-n-YCM) ) 

YCM3=YSHOC 
XCM)sXSHOC 
D = 0, 

DO 605 J=1,NSP 

ALP(J,vi)5:ALPCJ,M3+RAT*(AUPCJfM-U'^ALP(J,M3 ) 

605 ALPDUMCJ)=ALPCJ,M) 

CALL INTCRAT,D,D,THCM) ,P(M) ,QCM) ,RH0CM) ,R(M) , WCM)*GAM(M), 

1EM(M), XMUCM},T(M) ,D,D, TH(M-l),P(M*-U,Q(M-n,RHOC^1-n rRCM-n , 
lW{M-.l),GAM(M-U/EN'(M-l},XMU(M-n ,T(M-1},D,D,TH(M3 ,PCM3 rQ(M), 

1RH0(M),RCM),W(M3,GAM{M),EM(MJ ,XMUCM) ,T(M3 /ALPDUMaf lEQ) 

606 CONTINUE 
A=, 5 
B=,5 

GO TO 250 
?520 CONTINUE 

IFCIPENCE,EQ,0.DR,XNU ) ,NE,XCOWLH) GO TO 3108 
XXP=CYN(U^BFENCE)/AFENCE + XBP 
IFCXNCL) .LT.XXPJ GO TO 520 
DUM=(YNCU-YNCK) 3 / CXNCD-XNCK)) 

XXP=CAFENCE*XBP-BFENCE<^DUM*XN(K) + YNCK)3/(AF£NCE-‘DUM3 
3108 CONTINUE 

IFCIDEUGpEQ.n GO TO 2623 
IF(XJ1.EQ,0,,AND,IOVER,EQ,03 go TO 520 
2623 CONTINUE 

IF(XN(L3 .LT.XXJl CNXXJ) ,AND,XN(L) .LT.XXP) GO TO 520 

IFCLST.GT.O) GO TO 520 

LST=1 

XNNsXXP 

IF(XNCU ,GE.XXJ1 (NXXJ3 ) XNN^XXJUNXXJ) 

RAT=(XNN-XNCK)3/(XN(U-XNCK3 3 
I AA=IAA+1 

IF(IPP,GT,NPTS.0R,IAA,LT,IPP)G0 to 3999 
iNRiTECbf 39983 

3998 FORMAT C* INDEXING IN CHANGE OF ORIGIN OVERLAPS INITIAL DATA lAA EQ 
lUALS IPP*) 

STOP 

3999 XN(L )=XNN 

YN(L 3=YN(K)+RAT*CYN£L)-YNCK3 3 
THNCL )=THNCK) tRAT*CTHN(L)-'THNCK3) 

DUMlsALOGCPNCK) 3 
DUM2=ALDGCPNa3 3 
DUM=0U^1 + RAT*£DUM2*»DUM13 
PN£L )=EXP(0UM3 
IDPT=1 
A=1, 


B=0, 

GO TO >53 
6il0l 1DPT = 0 

IF(IF£MCE,EQ,O.OR.XNCn .NE.XCDt^lH) 60 TO 980^ 

IF(IAAeUT.3,OR,XF(l] .EQ.XFENCEJ GO TO 9804 
rtRITECbf9805) 

9805 FORMAT C* FENCE MAY NOT BE ENTIRELY SUPERSONIC • CHECK FLOrt FIELD*) 
STOP 

9604 continue 

DO 840a J-i,NSP 
ALPDUMCJ)=ALPNCJf L) 

8402 ALPFCJr IAA)=ALPN(J,L) 

D=0, 

CALL INTCO,rXNCL)rYNCU,THNCL),PNCU)r QN (U , RHON (U , RN CL ) , 

IWN(L) f GAMN(L) ,EMN(L) ,XMUNCL) rTNCL), 
lD,D,D,D,D,D,D,D,D,DrD,D 

IfXFdAA) rYF(IAA),THF(IAA),PF (lAA) ,QF(IAA) ,RHDFaAA),RFCIAA) , 
IWF(IAA) ,GAMFCIAA) ,£MF(IAA) fXMUFCIAA) ,Tf CIAA) , ALPDUM, 0 , I£S) 
IFCIAA,EQ,2,ANO,LSTT*EQ,0) 60 TO 520 
C ****y^** COMPUTE SIDEWALL FORCES ************ C 
IFCKSIOE.EQ,0)GO TO 521 
LT6=LTH+2 
MIsM 
I=M + 1 

IF( I,GT,KMAX)GQ TO 521 

519 Zl = AXXCNXXJ-n*CX CMD-XBP) +BXX CNXX J-»l ) 

Z2=AXXCNXXJ-n*(XN(L )-XBP) +BXXCNXXJ-1 ) 

Z35AXXCNXXJ^n*CX Cl )i-XBP)+BXX(NXXJ-l) 

Z4=Z3 

DO 5363 J^lfNSP 

5363 ALPDUMCJ)=CALPCJfMI)f ALPN(J,L)+ALPCJ, I) )/3. 

CALL LTHMCX(Ml), YCMI),Z1 fXNCL) f YNCU » Z2 r X C I ) f Y ( I ) f Z3r X ( I ) f Y C I ) , 
lZ4,PCMI),PN(L)rPa)rPCn/Q(Mn#QN(L)f Q(n/QCl)rRHO(Ml),RHON{L), 
2RHO(I),RHOCI) ,RCMI) ,RN(L) rRCDfRCI) fWCMI),WN(L)» WCI) ,W(I) , 

3THCMI) dHNCUdHCI) rTH(I), ALPDUM, , 3333 3 33333 ,, 33333 f 0 , , 

4XTHS,YLFTS,XMQMSiCFrST,3) 

STSCLT63=ST 
IFCI.EQ,KMAX)GO TO 521 
1 = 1 + 1 
LT6=LT6+1 
MI=MI+1 
GO TO 519 
521 LMAXsL 

LWUZ=LMAX 

IF(KSIDE.EQ,0)GD TO 265 
GO TO 5520 

520 CONTINUE 

IF(XNCU.LT^XXJ1CNXXJ).AND,XN(U,LT,XXP) go TO 5520 
IF(LSTT,£Q,0) GO TO 5520 
LMAX=L 
LWUZsLMAX 
GO TO 265 
6520 CONTINUE 
A=l, 

B=0. 

L=LMAX 

KKsKMAX 




' K=LMAX«i 
50U COMTINJE 

IFCB,EQ,0,> THNa) = TH(KK) 

IB=1 

IERkO 

630 CONTINUE 

EMSL=XM5(.5r ,5,TH(KKD rTHNCU ) 

EM2SXM2CA# 8,THN(K) ,XMUN(K), THNCLI r XMUNCU ) 
1FCIDESGN,EQ,0,AND.IFLIP,NE,1) 

ICALU BODLCXCKK),Y(KK) ,TH(KK) , XN CK } , YN C K ) , EM2 , XN (1 ) , YN ( L) , THN ( L ) ) 
IFdFtIP.NE.U GO TO 631 

CAUL GEMCX(KK), YCKK),EMSL/XN(K) f YN(K) ,EM2f XNCt3#YN(L) 3 

631 CONTINUE 

B1 = F1 (A,B,XMUN(K) ,GA1^N(K3 fPN(K) rXMUNCU iGAMNCU f PN(L3) 

XDUMK = XNCK)-XOR(NXXJ"l ) 

XOUMLsXNCL3*XQR(NXXJ-l ) 

B2=F2C A,6, -1 ,,XJrXJl rXDUMi<:,YN(K) ,THN(K) ,XMUN£K),XDUML, YN(L) ,THN(L3 

If XMUN(L) 3 

DUM1=BH*(XN(L)<-XN(K3) 

IFCXJltGT,Or3DUMl=B2*ALGG(XDUML/XDUMK3 
0UM= (THNa)-THNCK3"DUMi3/Bl 

PNa)=PNCK)*EXP(DUM3 
1821 CONTINUE 

DO 1503 J=lfNSP 
ALPN(J,L3=ALPCJf KK) 

1503 ALPDUMCJ)=ALPN( J,L3 

CALL SL(PCKK),0(KK3 ,RHO(KK)f RCKK) , 

1 WCKK) fGAMCKK) ,EM(KK) ,XMU(KK3 fTCKK), 

1PNCL3 f QNCL3 f RHONCL) ,RNCUfNN(U3 f GAMN(L) fEMNtU/XMUNCDf TN(L3f 
lALPDUM, lEQf A,B3 

IFCB,EQ,0, ,0R,IFLIP,EG,1)GQ TO 1523 
LlsLMAX 

IFCXN(L13 .GT.XXJl (NXXJ)-l .£'•043 GO TO 1523 
C ******* COMPUTE FORCES ON LONER SURFACE AND SIDEnALL *******C 
Zi::AXXtNXXJ"n*CX (KK)-XBP3 +BXX(NXXJ-1 3 
Z2sAXXCNXXJ«U*(XNa 3^XBPD +BXX (NXXJ-1 3 
Z3=»Z2 
Z4=-Zi 

call LTHMCXCKK) , Y(KK) , Z1 f XNCL3 f YNCL) f Z2f XN(L) f YNCL) f Z3f X(KK)f YCKK) 
If Z4fPCKK3 f PN(U* PNCL3/PCKK3 ,G(KK3 ,QNCL3 fON(L3 , 0 C KK 3 , RHO ( KK ) , 
2RHOWCL3 f RHDNCL3f RHOCKK3 f RCKK) fRN(L) f RN(L3 f RCKK3,W(KK) ,WNCL3 f WNCL) . 
3NCKK) ,THCKK3 ,THNa),THN(L3f THCKK3 f ALPDUM, .25, ,25, ,25f ,25,XTHX,YLFT 
4,XMOMrCFf STf 2) 

STLsST 

IF(KSIOE,EQ.O)GO TO 1523 

LTHsLTH+l 

00 1596 JalfNSP 

1596 ALPDUM( J3s:CALP(JfKK)+ALPN(J,K3 3/2. 

Zl=AXXCNXXJ-n*{X (KK)-XBP3+BXX(NXXJ"13 
Z2 = AXXCNXXJ-U*CXNCK )«XBP) + BXX (NXXJ-1 ) 

Z3=AXX(NXXJ-l)*(XN(L 3 -XBP3 +BXX (NXX J-1 3 
Z4 = Z3 

CALLLTHM(XCKK) , Y(KK) f Zlf XNCK) ,YNCK3 f Z2,XN(L3 f YN(L3 f Z3f XNCL) f YNCL3 . 
iZ4,PCKK3 f PNCK) f PNCL) f PN(L) rQ(KK) fGNCK) ,QN(U f QNCL3 f RH0CKK3 ,RH0N(K) 

2f RHONCU f RH0NCL3 f RCKK3 , RN (K) , RN CL } , RN CL 3 , W CKK 3 , NN CK) , i^N{L3 , NN CU r 
3THCKK3, THNCK) ,THN(U fTHNCL3 fALPDUM, .33333, .33533, .33333,0., 
aXTHS, YLFTSfXMOMS,CF,ST,33 


15^3 lF(IFLIP,NE,i) GO TO 632 
P2 = PNCU/PCKK) 

CALL PRMCP2,TH(KK) ,EMC1 , TH2 V, tMC2, + 1) 

ERasTHaT-THNCL) 

IFCABSCERiJJ .LT,l.E-"04) GO TO 632 
CALL ERRCIERrlB^THNCU ,ER4a,01,THML,ERl5 
IFCIER,EQ,0)GO TO 166 
633 WRITE(6f635) 

635 FORMATC* ERROR IN PM LOOP AT CONTACT IN MAIN*) 

STOP 

166 IBsIB+i 
GO TO 630 
632 CONTINUE 

IF(B,GT,0.) GO T01265 

A=,5 

B=.S 

GO TO 5011 
1265 IAAS=IAA 

IFClFLIP.EQ.a.AND.XNCL) .GE.XFINAL) IHALT=1 

IF£IHALT,EQ.n GO TO 1802 

IFCXN(U) iGE.XFINAL) go TO 1802 

IF(lDELG,Ea,n GO TO 3109 

IFCXJl ,EQ,0, ,AND,IOVER,EQ,0) GO TO 265 

IFaFENCE,EQ,0,QR*XNa) ,NE,XC0WLH) GO TO 3109 

IF(XNCL)*LT,XFENCE) GO TO 265 

XNNsXFENCE 

GO TO 3110 

3109 CONTINUE 

IFCXNCD.LT.XXJICNXXJ)) GO TO 265 
1802 CONTINUE 

XNNsXXJl CNXXJ) 

3110 CONTINUE 

RAT = (XNN"X(KK))/CXNCU**X(KK)) 

IAA = 1 

lstt=i 

LWUZsLMAX 

XFCIAA)=XNN 

IFCIFLIP,EQ.i) GO TO 2605 

XCHsXNN -XINTL 

LKr5 

IF(XCH,LT,XXLC5) )LKs4 
IF(XCH,LT,XXL(4) 3UK=3 
IFCXCH,LT,XXL(33) UK=2 
IF(XCH,LT.XXL(2) ) LK=1 

YFCIAA)=AA1 CLK,2)*XCH*XCH+AA2CLK,2)*XCH+AA3£LK,2) 
THFCIAA)=ATANC2.*AAHLK,2)*XCH + AA2CLK,2)) 

GO TO 2606 

2605 YFCIAA)=Y(KK)+RAT*CYN(L)-Y£KK3 3 
THFUAA)=ATAN(TAN(THCKK) 3+RAT*(TAN(THNCL) )-TANCTH(KK3 3 3 ) 

2606 CONTINUE 
YNCL3=YF(IAA) 

THNCL3=THFCIAA3 

XNfl IsXFfTAA^ 

PN(L3s:PCKK)+RAT*(PNtL3-PCKK)3 
QN(L3 = 0CKK3+RAT*(QN(L3*“QCKK33 
TNCL3=TCKK3+RAT*(TN(L3-TCKK3 3 


DO 3041 J=l»NSP 
AlPFCJf XAA)sALP(Jrf<K) 

ALPNtJfU=ALPCJ,KK) 

ALPDUMCJ)=ALPNtJ,U 
3841 CONTINUE; 

CALL SL(PCKK),Q(KK),RHD(KKJ,RCKK}f 
1 WCKK),GAM(KK),EMCKK),XMU£KK) ,T(KK), 

iPNCU ,QNCL)#RHONCU ,RN(U f WNCL) fGAMNCU ,EMNCL) f XMUNCLl f TN(L) , 
lALPDUM,IEQf .b,.S3 
D=0, 

CALL INTC0,#XNCL3,YNa),THNCL),PN£L)^ QNaD f RHON (U f RN CL) r 

1WNCL),GAMN(L),EMN(L),XMUN£L), TN(L), 
iDrDfDrOfDfD/D/DfD/D^D^D 

WDUM3 fDUMl ,DUM2 , PP C lAA) , QF C IAA3 , RHOFCIAA) , RF C UA) , 

lHF£IAA)f GAMFCIAAJ/EMFCIAA) ,XMUFCIAA) , IF ( I AA) , ALPDUF’, 0 , XEQ) 

c **aj^*** cd'ipute forces on lower surface and sidewall *******C 

Zl=AXXCNXXJ-n*CX CKK).XBP3+BXX(NXXJ-1) 

Za = AXXCNXXJ*^l)*CXN(L )<-XBP) tBXXCNXXJ-*!) 

Z3=">Z2 

Z4s:-Zl 

CALL LTHMCXCKK) , YCKK) ,Zlf XNCL)» YNCL) , Z2 r XM tL ) r YN ( L) r Z3, X ( KK ) , Y C KK ) 

1, Z4,P(KK) ,PNCL),PNCU,PCKK) ,QCKK) ,QNCL),QNCL)#«CKK) rRHOCKK) , 
2RH0N(L) rRHONCL) f RHOCKKl fRCKK) ,RN(L)#RNCL) rR(KK),W(KK), WNCL) ,WN(L) f 
3rt(KK) ,THCKK),THNCL) fTHNCU f THCKK), ALPDUM, ,25, ,25, ,25^.25,XTHXrYLFT 
4,XMOM,CF,ST,2) 

STL=ST 

IF(KSIDE,EQ,0)GO TO 264 

LTH=LTH+l 

DO 1597 J=1,NSP 

1597 ALPDUMC J)=( ALPCJ,KK)+ALPN(J,K)3/2, 

ZUAXX(NXXJ-n*tX CKK)<-XBP)+BXXCNXXJ-n 
Z2=AXX(NXXJ*»n*(XNCK )-XBP) +BXX CNXX J-13 
Z3=AXXCNXXJ-n*CXNCL )-XBP) +BXX CNXXJ-1) 

Z4 = Z3 

CALLLTHMCX CKK) , YCKK) ,Z1 , XN C K ) , YN ( K 3 , Z2, XN ( L) , YN CL ) , Z3 , XN £ L ) , YN CL) , 
1Z4,P(KX3 ,PNCX3 ,PNCL3 fPNCU rOC KK) ,QNCK3 ,QNCL3 ,QNCU ,RH0CKK) ,RH0NCK3 

2 , RH0N(L) ,RHDNCL) ,RCKK) ,RN(K3 ,RNCL) ,RNCL3 ,WCKK) ,WNCK) ,WNa) , WNCL3 , 
3THCKK) , THNCK3 ,THNCL 3 ,THNCL3 ,ALPDUM, ,33333, ,33333, ,33333,0,, 
4XTHS,YLFTS,XM0MS,CF,ST,33 

STSCLTH3=ST 

264 IAA=IAAS 

265 CONTINUE 

C IF(PNaMAX),LE,PEN,AND,IDESGN,EQ,13 GO TO 7634 

CALL WUZZYCN,NPTS,KMAX,LNAX, IPP, IFZ,LWUZ3 
KMAX=LMAX 
BETsBETN 
EMCi=EMC2 
D-0, 

DO 270 K=1,KMAX 
DO 271 J=il,NSP 
271 ALPCJ,K3=ALPNCJ,K3 
DO 1504 J=1,NSP 
1504 ALPDUMCJ3=ALPCJ,K) 

CALL INTCO, ,XNCK3, YNCK3,THNCK3 ,PNCK),QNCK3 ,RHONCK) ,RN£K5 ,WN(K3 , 
1GAMNCK3,EMN£K3,XMUNCK3 ,TNCK3 , 
lD,0,DrD,OfD,OfD,0,DrD,D 

1,XCK3 ,YCK) ,THCK),PCK),QCK3 ,RH0CK3,R(K3,WCK3,GAMCK3, 



ltM(K),XMUCK) ,T(K),AIPDUM,0/1EQ) 

^70 CawTIfV’JE 
LMAX=KMAX 

7266 IF(N-.NPTS) 7201,7202,500 

7201 N=N+1 

GO TO 500 

7202 CONTINUE 
NSTARsl 
N=Ntl 

GO TO 500 
9123 KTEST=KMAX/2 

KTESTl=(KMAX-l)/2 

KT3=KMAX**1 

IPCKTEST.EQ.KTESTID KT3=KMAX 
1 = 0 

DO 6412 U=l,KT3,2 
1 = 1 + 1 
D=0. 

DO 6414 J=1,NSP 
AUPDUMCJJ=ALPCJ,L) 

6414 ALPCJ,I)=AUPCJ,L) 

call INTCO,,XCU,YCU,TH{L3,PCU,Qa),RHOCU,R(U,WCU,GAMCL) , 

lEMCL),XMU(U,Ta), 

1D,D,D,0,D,D,D,D,D,D,D,D 

i,xci),y(i),fHcn,pci),GKn,RHDtn,Rn),w(i3,GAMcn,EMcn, 
IXMU(I), TCI) , ALPDUP>,0, lEQ) 

6412 CONTINUE 

IFCKTEST^EQ.KTESin GO TO 6413 
1 = 1 + 1 
U=KMAX 
D=0 • 

DO 6415 J=1,NSP 
ALPDUMC J) = ALPCJ,U 

6415 ALPCJ,I)=ALPCJ,L) 

call INTC0,,XCL),YCL),THCU rP CL), QCU,RH0(L),R(U,W(L),GAMCL), 
lEMCL),XMUCL},TtL), 

1D,D,D,0,D,D,D,D,D,D,D,D 

1,X(I),Y(I) , TH£I),PCI),Qm,RHOCn ,R(I),WCI),GAM(I) ,EMCU, 
IXHUCI), TCI) ,ALPDUM,0,IEQ) 

6413 KMAX=KMAX/2+l 
LMAXsKMAX 

GO TO 6060 
END 


SUBROUTINE INOATA 

GO;'^MON/>IOT/AH(33 ?BHC3> rCHtS; , XSTR,PR,REC#REiiaf RT,Sh, Ilrt, J'vIS 
COMMON/.VISF/XVTHX, YVLFT , XVMOM 

C0MM0N/.C0rtL/IC0WL,MM,XM(9) , YM(9) ^pvic9),WMC9) , RHMC9) , THY(9) , 0MC9) , 
1RM(9) ,TM(9) ,GM(9),XMUMC9) ,EMM(9D , ALPMC7f 9) ,CPXM(9) 

COMMQN/.SHAPE/Al (5,21 f A2C5,2) ,A3C5r5) f XXUC5) r XXL(53 fXINTUfXiNTL 
COMMON/.LTM/XSHFTr YSHFT/XTHX,YLFT,XMOM,XTHS, YLFTS,XMOMS,KSlDE 
COMMON/.XXJ/NXXJl ,XXJ1 (fj) ,AXXCfa3 ,DXXC63f XDR(6) 

CDMMON/.XFINAL/XFINAL 
COMMON /SP/ NSP 
COMMON/.A/ TINfCPINrRD 
CDMM0N/.3/ WTMOLE 

CDMMON/.D/ GAMINFrfc'MINF ,RINF,rtINF 
COMMON/f /A9, B9, 180D, XWF,NBODi VEND 

COMMON/,ETX/XJ,XJl,NPTS, 10, IREFL, ICHEM, IPUNCH, IDESGN, IR,NXX, XBP, 
iyap,TH5P,RAD, X60D,YB0D,THB0DrRADB,XEND, THEND,RTH, YEXIT, THST/TEST# 
lIRFLf YO,RAOB2,RRAD(203 , NSTAR, YNOZ, EIN, PENrH16,Hl7 
COMMON/,XF/XFC200) , YF C200 ) , PF (2003 , OF (200 3 , TFC200) , THF (200 3 , ALPF C 
110,2003 

COMMON/.X/ X (2003 ,Y (2003 , PC200) ,QC2003 rT (2003 ,THC2003 ,ALP( 10,2003 

CDMMDN/.XCDWL/XCDWL 

COMMON/f YAR/ 

1RHOF(200 3, CPXF (200 3 ,EMF (2003 ,XMUF (2003 ,WF (2003 ,RF( 2003 , GAMP (2003, 
2XMASSF(2 00 3 , HF (2003 ,SF (200) , ALPOUO) , 

3THETA(20) 

COMMON/.VAR/RHD(2003 , 

1EM(2003,XMUC2003 ,CPXC2003 ,W(2003 ,R(2003 ,GAM(200) ,XMASSC2003 , 

2 XN(200),YNC2003,ON(2003,TN(20Q),PNC2003,THN(2003, RHQN 

3C20O) ,EMN(2003 ,XMUNC200) ,CPXN(2003 , WN(2003 ,HNC200) ,GAMN(2003 , 
ilXMASSN(200) , ALPN(10,200) ,SIC103 ,HI(103 ,TEMP(20) 

5, ALPOUVU103 

COMMON/JEQ/IEQ,PIN,RHDINF,UINF,PINF 
COMMON/IDEAL/IOEAL,GAMEY, XMWT ,CPI 
COMMON /IGVER/ lOVER 
C0MM0N/,XTJ1/XTJ1 

CQMMON/fENCE/IFENCE, AFENCE,BFENCE,XFENCE 

DIMENSION v^TMOLEClO) ,TYPE(63 r TYPElCA) ,TYPE2C23 ,TYPE5(«),TYPEaCa) 
DATA TYPE2 /lOH NOZZLE , 1 OHCENTERBGD Y/ 

DATA TYPCl/lOHHYDPOGEN A , 1 OHH YPROC ARBO , PH I R , 5HN AIR/ 

DATA TYPE/IOHTWO DIMENS, 1 OHAXISYMMETR, 1 ONLINE S0URC,5HIDNAL,5HIC 
1 ,SHE / 

DATA TYPE5/10HF LOW ,10H D E S ,9HF I E L D,9HI G N / 
DATA T YPEA/IOHFROZEN , lOHEOUlLIBRIU, IH ,1HM/ 

DATA X XU/5* UE+06/,X XL/5* l.E+06/, END/ i,E+0fa/ 

DATA IOVEK/0/ 

THST=,02 

IF(IOVER,EQ,23 GO TO 916 

10=0 

IREFL=0 

IPUNCHsO 

lOESGNsO 

ICHEMsO 

READC5,6B95) Jl, J2,NPTS, IEQ,ICDWL,IOVER,MM,IDEAL 
READ(5,6895)KSI0E, IVIS, ITW 
5100 NSP=7 

READ (5, 653 X8P, XROD, XCDWL, RTH, TEST, XFINAL , XT J 1 
6895 FORMATUSIS) 


READ (5,63) XSHFTr VSHPT / XTHX, YLFT , XVIOM 
READC5r63JXTHS,YLFTS,XM0MSrXVTHX,YVLFT,XVM0M 
REA0t5,6895) NXXJl 
DO 9393 l = WlMXXJi 

9393 READC5r9i*63J XX J1 (I ) , AXX C I ) , BXXU ) , XOR C 1) ’ 

9^i63 FORMATC4E10,OJ 

READ (5, 4) IF£MCE,AFENCE,BFENCEf XFENCE 
4 FORMAT(I5,5X3£10,0) 

XXJl(NXXJl + n=XFINAL 
AXXCNXXJl + n=AXX((\iXXJl) 

BXXCNXXJl + n=BXX(NXXJl ) 
xoR cNxxji + n=xaR (Nxxjn 
IF(IFENCE,EU,0) GG TO 321 
XXJICNXXJ1+2)=XFINAL 
AXX CMXXJl+2)sAXX CNXXJl) 

8XX (NXXJ1+2)=:BXX CNXXJl) 

XOR CNXXJ1+23=X0R CNXXJl) 

321 CONTINUE 
XINTUsXBP 
XINTL=XB0D 

REAaC5,6695) NUWSEG , NUWSEG 

R£ADC5,65fa3) C XXU CL) , A 1 (L , 1 ) » A3 CL r 1 ? , A3 CL f 1 ) , L=1 / NUwSEG) 

READ (5, 6363) C XXL CL ) f A 1 ( L, 2) , A2 CLr 2 ) , A3 CL , 2) # L = 1 r NLWSEG) 

6363 FORMAT C4E10»0) 

3531 WRIT£C6,7329) TYHE5 C lDESGN+1 ), TYPES C IDESGN+3) 

7329 FORMArC 41X*N OZZLE ^ CENTERBDDY *//50XA10, A9) 
JP1=JI+1+2*J2 
JP2=JP1> 3 

WRITEC6,7330) TYPECJPl ),TYPECJP2 ) ^TYPEl CICHEM+I 3 

WTYPEl CICHEM+3),NPTSrRTH 

7350 FQRMATC /37X,*F DR NQNUNIFORM GAS FLOW 

2*/// 10Xf*TYPE OF FLOW IS *,Al0fA5,* FOR *r 

3Al0,A5/.10Xr*NUMBER OF POINTS ON INITIAL DATA LINE IS *,I3/.10X, 
4*THR0AT RADIUS CRTH) = *,E13,S) 

WRITE C6f 50 01) TYPE^f C lEQ + l ) , TYPE4 C IEQ + 3 ) 

5001 FORMATC 

UOX*CHEMISTRY IS *A10rA13 
WRlTE(far7500) XC0WL,XFINAL 

7500 FORMATC10X*COWL TRAILING EDGE IS *E13.5/1 0X*AXIAL COORDINATE OF EN 
ID OF RUN IS *E13,5) 

IFCJ2,EQ*0) GO TO 7510 
WRITECbf 7501) XTJl 

7501 F0RfviATC10X*AXIAL COORDINATE OF START OF CARTESIAN SYSTEM IS *E13,5 

1 ) 

WRlTE(6r7502) 

7502 F0RMATC//2SX^^LINE SOURCE COORDINATES*) 

WRlTEC6r7505) 

DO 7503 I=l,NXXJl 

7503 WRITECSf 7504) XX J } C I) # XX J 1 C I +1 ) f AXX C I ) f BXX C I ) , XOR C I) 

7504 FORMAT(IOX,4E11,3 i5X,eil ,3) 

7505 F0RMATC15X*X*4X*TU*4X*X*11X*C00RDINATES*12X*0RIGIN X*) 

7510 CONTINUE 

WRITEC6,2020) 

2020 F0RMATC//25X*UPPER WALL COORDINATES*) 

WRITEC6f2071) 

2071 FDRMATCi5X*X*4X*T0*4X*X*15X*C00RDINATE5*) 

2042 FORMATC10X,5E11,3) 



^ * 


DO 2050 I^W'rJl'jSEG 
1FCI»EU,5}G0 i’O 2051 

rtRITEC6r20a2) XXU U ) p XXU C l + n f A1 £1 , 1) , A2 ( I f U , A3 C I r i) 

GO TO 2050 

205i rtRIIE(£>,20i»2) XXUCHrEND , A I £ 1 , 1 ) , A2 1 1 1 } , A3 (1 , 1) 

2050 CONTINUE 

rtRITE(fa,20l0) 

2010 F0RMATC//25X#-L0WER WALL COORDINATES*) 

WRITEC6r2071) 

DO 2040 I=1,NLWSEG 
IFCI.EQ,53GQ TO 2041 

WRITE (6 #2042) XXL £ I ) # XXL C If 1 3 # A1 £ 1 , 2 ) , A2 C 1 # 2) # A3 £ I # 2) 

GO TO 2040 

2041 WRITEC6,2042) XXLCI),END , A 1 f I # 2 ) # A2 Cl # 2) / A3 Cl , 2) 

2040 CONTINUE 

DO 7373 L=1,NUWSEG 

7373 XXUCDsXXUCD-XINTU 
DO 7374 L=1#NLWSEG 

7374 XXLCL)cXXLCL)-XINTL 
READC5#63) EMINF # T IN, Wl NF # PINF 
IFCIDEAL.EQ, nREADC5,63)GAMEY,XMvn 
1F£I0EAL.EQ.1HED=1 

DO 5002 I=lfNPTS 
DO 5002 J=:l,NSP 
5002 ALPFCJ, I)=0, . 

READ £5, 636 4) (XF ( I ) , YF £ I ) , PF £ I ) , QF £ 1) , TF Cl ) , THF ( I ) , WF (1 ) , 1 = 1 , FgpTS ) 
IF(IEQ.EQ.O) 

1READC5,6364) C CALPF CU, I ) , J=1 ,NSP) , 1=1 , NPTS) 

6364 FORMATC7EIO.O) 

IF£IC04L.EO*0)GO to 7511 

READC5,6364)XMCMM3 , YMCMM),PM£MNi),QMCMM) ,TM£MM) ,THM£MM) 

DO 6186 J=1,NSP 
6186 ALPM£J,MM)=0, 

7511 CONTINUE 

IF(IC0WL*EQ,1)WRITE (6,5005)MM,PM(MM) ,0M£MM) ,TM(MM) ,THM£MM) , WM(MM) 
5005 FQRMAT£//20X*OATA AT COWL*/ 1 0X*NUMBER OF POINTS IN PRANDTL-ME YER F 
IAN IS *I2/10X*PRESSURE =*£ 1 3 , 5/ 1 0 X* VELOC I T Y =*E 

U3,5/10X*TEMPERATURE =*E13,5/iOX*FLOW INCLINATION =*E13,5/ 

110X*FUEL TO AIR RATIO =*L13,5) 

IF(IVIS.EQ,0)G0 TO 832 
READ£5,63)XSTR,PR,REC,REIN,SH 
IFUTW.GT.OGO TO 632 
DO 831 L=l,3 

831 R£AD(5,63)AHCL),BH£U,CHCL) 

832 CONTINUE 

IFCIREFL.EQ.O) 60 TO 4000 
916 CONTINUE 

DO 4005 I=l,NPTS 

llsNPTS-rI + 1 
XCII)=XFCI) 

YCII)=-YF£I) 

Q(II)=QF(I) 

TdDsTFCI) 

PCII)=PFCI) 

THCin=-THF(I) 

RCn)=RF(I) 

W(II)=WF(I) 



DO UQIO J-lfN3P 

4010 ALP(J,II)=ALP>'CJ,n 

4005 CONTINUE 

DO 4006 I=lrNPTS 

xFa)=xci) 

YFa) = Y(I) 

QF(I)s:Q(I) 

TFCI)=T(I) 

PFCI)=PCn 
THFCI)=TH(IJ 
RFClJcRCI) 
rtFCI) = /^Cn 
DO 4007 JslfNSP 
4007 ALPFCJ,I)=AtPCJf I) 

4006 CONTINUE 
DUM=*tYBP 
YBPs-YBOD 
YBUO;:DUM 

dum=*thbp 

THBP=^THBOD 

thbod=oum 

YENDs-YENO 
THENQs-THEND 
IFCI0VER*E0,2) RETURN 
4000 CONTINUE 
XJ = J1 
XJ1=J2 

WTMOLECU = l .OOS 
WTM0LE(:2)=16, 

NTMQLE(3)slB,016 

WTMOLEC4)=2,016 

WTMOLE(5)=52.0 

WTMOL£C6)=17,008 

WTMOLEC73=28,014 

NTM0LECfl)=44.01 I 

rtTMOLEC9)=28,011 

WTMOL£C10}=44,1 

R0=l,987 

CALL C0EFF(5,TIN,AZrBZ,CZf DZ,Ei!,FZ,tZ] 

CPIN=CAZ+BZ*TIN+CZ*TIN**2+0Z*TIN**3+EZ*TIN**4)*R0/WTM0LE(5) 

CALL C0EFF(7,TIN,AZ,82,CZ,0Z,EZ,FZ,GZ) 

CPn=CAZ+BZ*TINtCZ*TIN*^2+0Z*TIN**5+EZ*TlN**4)*RD/WTM0LEC7) 

RINF=R0/NINF 

CP1N=,232*CPIN+,768*CPII 

GAMINF=i,/(l,-RINF/CPINJ 

GAMINFsl,4 

EIN= (GAMINF-»1,) * EMINF**2 
PIN=1 ,/GAMINF/EMINF*a2 

IF(IDEALflEQ,l)CPI=49712,52*GAMEY/(GAMEY- 1 ,)/XMWT 
NRITE(6,6899) EMINF,TIN,V^INF,PINF 
6899 FORMATC// SOX, ^INFINITY CDNDIT IQNS*/50X, 

l/40X,*MACH El 3, 5/4 OX,* TEMPERATURE (DEGREES 

2 K) — ^*,E13,5/40X,*MOLECULAR WEIGHT £13, 5/40X 

l*PRESSURE £PSF) ^--^*E1 3,5) 

WRITE(6,6723) 

6723 FORMATC///40X,*OUTPUJ VARIABLES ARE*/40X, *N0NDIM£N5IDNALIZED*/ 

140X,aAS follows "*//40X,*X BY RTH*/40X,*Y BY RTH*/40X,*Q BY FREE S 


2TREAM VELDi.ITY*/ilOX.*T BY FREE STREAM TEMPERATURE*/40Xf *P BY FREE 
3STREAM PRESSURE*) . , 

IF(IEQ,EQ,0) t^RITE(6,5003) 

5003 FQRMATC /40X,*ALP(J) IS MASS FRACTION OF SPECIES J*) 

DO 6897 I=lfNPTS 
PFCnsPF(I)*PIN 
6897 CONTINUE 

IFCXCONL,EQ,nPM(MM)sPM(MM3*PIN 
UINF=17l6,ATIN*i, 8/PIN 
RHOINFs PINF/TIN/1 ,8/!716, 

H16=GAV)INF/wINF/2,*EMINF*EMINF 
H17 = U/,H16 
63 FORMAT(8EI0,0) 

PINFSPINF/2U6, 

DO 4321 I = KNPTS 
DO 63 JslrNSP 
63 AlPDUM(J)=AUPFCJrI) 

CALL ALL CPFCI)rQF(I),RHOF(n,RFCI)rWFCI),GAMFa)rEMFCl)f 
iXMUFa),TFCIJ,ALPOUM,IEQ, U 
4321 CONTINUE 

IF(ICD4L*EQ,0)RETURN 

IDEAL5=0 

IEQSsIEQ 

CPIS=CPIN 

GAMES=GAMINF 

XMWS=WINF 

IFCIDEAL.NE.nOOTO 717 

iDEALSsIDEAL 

GAMES=GAM£Y 

CPIS=CPI 

XMWS=XMWT 

717 CPI=CPIN*25, 02006*1, £+03 
GAMEY=GAMINF 
IDEAL=1 
IEQ=1 
XMWT=WINF 
DO 84 JslrNSP 
T4 ALPDUM(J)=ALPiM£J,MM) 

call all CPM(MM),QMCMM)rRHVICMM3,RM£MM),WMCMM),GMCMM),EMM£MM), 
IXMUMCMM) rTM£MM),ALPDUM,IEQ,n 
lEQsIEQS 
ID£AL=IDEALS 
GAMEY=GAMES 
CPIsCPIS 
XMiVT=XMrtS 
RETURN 
END 


SUBROUTINE COEKFClfTrA ,8 tC ,0 


IFCT-1000) 10, i0,20 

10 GO 

TO (15,16,13,11,1 

11 A 

= 2,8460849E 00 

6 

= a,1932ll6£-03 

C 

S-9.6119332E-06 

0 

s 9.5122662E-09 

E 

=-3,3093421E*12 

F 

S-9.6725372E 02 

G 

=p*l,41 17850E 00 

GO 

TO 40 

12 A 

s 3.7189946E 00 

B 

=-2,5l67288E-03 

C 

s 5.5837353E-06 

D 

Si.6,29987l6E-09 

E 

= 2,7082i80E*12 

F 

=*l,0576706E 03 

G 

5 3,9080704E 00 

GO 

TO 40 

13 A 

= 4.1565016E 00 

S 

S-U7244334E-03 

C 

= 5.6982316E-06 

D 

=^4,5930044E-09 

E 

s 1.4233654E-12 

F 

=«3*0288770E 04 

G 

=-6,86l6246E-0l 

GO 

TO 40 

m A 

= 5,6916148E 00 

B 

=-l,3332552E"03 

C 

2. 2,6503100E"06 

. D 

s-9,7668341E-10 

E 

=-9,9772234E-14 

F 

= .-l,0628336E 03 

G 

= 2,26749B0E 00 

GO 

TO 40 

15 A 

2 2.5000000E 00 

B 

= 0.0 

C 

B 0.0 

D 

= 0,0 

E 

= 0,0 

F 

•= 2.5470497E 04 

G 

=»p4,600l096E-0i 

GO 

TD 40 

16 A 

s 3.0218894E 00 

B 

5-2,1737249E*-03 

C 

s 3,7542205E-06 

6 

S-2.9947200E-09 

E 

= 9.0777547E-13 

F 

2 2.9157190E 04 

G 

=. 2.6460076E 00 

GO 

TO 40 

17 A 

s 3.8234708E 00 

8 

5-1,11872298-03 

C 

c 1 ,2456819E-06 

D 

s-H, 1035896E-10 

E 

= ,-5,2546551E-14 

F 

5 3,5852787E 03 


G = 5,6a530a9E-01 
GO TO i}0 

18 As2,l70l 

Bc:l .0378USE-02 

C=-1,0735938E-05 

D=6,3459175E-09 

ES-1.6280701E-12 

F=-4,8352b02£+04 

G=l,0664388E+01 

GO TO 40 

19 AS3. 7671332 
B=*2,1709526E<.03 
C=5,0757337E-06 
D=-3.a737726£-09 
£=7,72l684l£-rU 
F=-l,4363508Ef04 
6=2,6335459 

GO TO 40 

20 GO TO C25,26,23,21,22,27/24r28,29),I 

21 A = 3,0436B97E 00 
B = 6,1187U0£-04 
C =*.7,399355lE-09 
D =-2,0531907E-U 
E s 2.4593791E-15 
F =-8.5491002E 02 
G =-U648l359E 00 
GO TO 40 

22 A = 3.5976129E 00 
B = 7.8145603E-04 
C s- 2,2386670E«07 
D s 4.2490159E-U 
E^ =<-3.3460204E-15 
F =-1,T927918E 03 
G ? 3,7492659E 00 
GO TO 40 

23 A 5 2.6707532E 00 

B = 3,03l7ll5E-03 
C ='*B,5351570E'»07 
0 = I, 1790853E-10 

E s»6,1973568E-l5 
F s«2,988899«E 04 
G = 6,8838391E 00 
GO TO 40 

24 A =. 2.8545761E 00 
B = 1,5976316E"03 
C =-6,2566254E-07 
D = i,l3l5849E-iO 
E S-.7.6897070E-15 
F =»*a,90174«5£ + 02 
G = 6,3902679E 00 
GO TO 40 

25 A = 2,5000000E 00 
B =0,0 

C =0.0 


D = 0.0 

E = 0,0 

F = 2,5470497E 04 


G s*a,6001096E'»01 
GO TO i\Q 

26 A = 2.5372567E 00 

C s*6,8017921E-09 
D = 5.96il36HlE-.12 

E -*"5 * 57 ^ti608E*» i 6 

F = 2,9250007E O^i 
G 5 4,9467942E 00 
GO TO 40 

27 A = 2.6895544E 00 

0 = 9,983506lE-0a 

C ;:-2, 1B79904E-07 
0 s l,9802785E-il 
E S-3,8452940E*^16 
F = 3,8011792E 03 
G = 5,55970i6E 00 
GO TO 40 

28 A=4, 4129266 
B=3,l922696E-03 
C=-1,297823E*.06 
0=2,4147446£*»10 
E=-1.6742986E-14 
F=«»4,89aa043E + 04 
G5-.7.2B75769E-01 
GO TO 40 

29 A=2, 9511519 
B=l,55255767E-03 
Cs*6a9114UE-07 
Dsi,l350336E-i0 
E=-7,7B82732E-15 
F=^l,423l827E-»04 

' 6=6,531445 

40 RETURN 
END 


SUBROUTINE ALL (Pr Q, RHr GAM,EM, XMU, T, ALPDUM, lEQr I&6) 

COMMON/ Tfca/.T eg ^ p„jM, rHG INF, UINF.PJNF 

COMMON/, A/ TINrCPIN,RO 

CQMMON/JD/ GAHINF,EMINF,RINF,WINF 

CDMMON/.B/ t^TMOLE 

COMMON /SP/ NSP 

COMMON /ENTH/ HX 

DIMENSION Hia0),CPlC10)f ALPDUMClO),WTMOLECiO) 

QPJ^—Q 

IFCIEQ.EQ, U60 TO 69 

wx=o. 

CPX=0, 

HX=0. 

DO 10 J-l^NSP 

10 rtX=WX+ALPDUMCJ)/WTMOUECJ) 

W=1,/WX 

IF(I66,EQ,nRH=P*W*EMINF**2*GAMINF/R0/T/WlNF 

IF(I66,EQ,0) 

tT=P*W*£MINF**2*GAMINF/RD/RH/WlNF 
call THERM0CT,H1,CP1,DUM) 

DO 20 J=1,NSP 
CPX=CPX+ALPDUMCJ)*CP1CJ) 

HX=HX+ALP0UM(J)*H1CJ) 

20 CONTINUE 

IF(I66,EQ,nK=:HX+Q*0/2, 

If CI66.EQ,0) 

1Q=SQRTC2,*CR-HX)) 

GAMsCPX/CCPX-tRD/W/CPIN) 

A=GAM*P/Rri 

A=SQRTCAJ 

EMsQ/A 

XMU=sASIN(l,/EM) 

RETURN 
69 CONTINUE 
IER=0 
IT=1 

IFa66,£Q,0)GO TO 40 
HX=FHCP,W,T) 

R=HX+Q*Q/H, 

RH=RHEQ(HX,P,^,T) 

GO TO 45 
40 HX=R-Q**2/2* 

RHT=RHEQCHX/PrW^T) 

£Rs(RH-RHTJ/RH 

IF(ABSCER) ,LT,1.E-03)GO TO 45 
call ERRCIER, IT,Q,ER, i,01,Ql,ERn 
IF(IER,£Q, i)GO TO 102 
ITsITtl 
60 TO 40 

45 GAM™FGAM(T,P, W5 
A=SQRTCGAM*P/RH) 

EM"Q/A 

XMU=ASINCU/EM)‘ 

RETURN 

102 WRITEC6, 105) 

105 FQRMATC* TOO MANY ITERATIONS IN ALU 
STOP 



SUBROUTINE BOOL (XI , Y I ^ THI , XL, Yl f EM2, XN, YN, THN J 

COMiviON/SHAPe/Ai (b,23 ,/.2(5,2) ,A3(5f 2) ,XXU(5}, xX U 5 3 # X 1 NTU ^ X I^;TL 

XUXI-XINTL 

XL=XL-XINTL 

ICK=1 

lERsO 

L=5 

ASU=TAN(THI) 

XN:;CYI-YL + XL>tEM2»»XI<fASU/(EM2«ASL) 

5 CONTINUE 

IF(XN.LT.XXLC5)) L=a 
IF(XN,LT,XXL(4n L = 3 
IF(XN,LT.XXL(3)) L=2 
IF(XN.LT,XXL(2)) L=i 
YNsAI CL,23*XN*XN+A2(L,2)*XIHA3CL, 2) 

YT=YL+CXN-XL3*EM2 

ER=tYN-YT) 

IF(ABS(ER) ,LT,l.E-04) GO TO 10 
CALL ERRCIER,ICK,XN,ER, 1 ,0i,XNl,ERn 
IF(IER,EQ,0)GO TO 350 
WRITEC6,3512) 

3512 FORMATC* TOO MANY ITERATIONS IN BOOL*) 

STOP 
350 L=5 

ICKaICK+1 
GO TO 5 

iO THN=ATAN(2.*AlCL,23*XN+A2CL,2n 
XI?XI+XINTL 
XLeXL-i-XINTL 
XN=XN+XINTL 
RETURN 
END 


SUBROUTINE BOOUCXI , •'I , THI r XL f YL - £ M1_- X, Y , TH) 

C0MM0N/.SHAPE/AlC5^2)f A2(5,23 f A3ii5r5) #XXU(5J,XXU5),XINlUf XINTU 
XI=XI-XINTU 
XLsXL-XINTU 
X=X-XINTU 
ICK=1 
lERsO 
5 U *5 

IF(X,LT.XXUC5)) L=a 
IFCX.LT.XXUCa)) L=3 
IFCX.LT.XXUCSn L=2 
IFCX,L,T,XXUC2)) L=1 
Y=Ai (1, n*X*X + A2(L, n*X + A5CL, i) 

YTcYL+CX-XL)*EMl 

ER=(Y-YT) 

IFCABSCER) ,LT.l.E-Oa)GO TO 10 
call ERRCIERfICK,X,ERri,01,XNl,ERl) 

IF(IER,EQ,0)GO TO 350 
WRITECb,35l2) 

3512 FORMATUXf * TOO MANY ITERATIONS IN BODU *) 

STOP 

550 CONTINUE 
ICK=ICK+1 
GO TO 5 

10 TH=ATAN(2,*Aia,13*X + A2CL,l)3 
XI=XI+XINTU 
XU=XL+XINTU 
X=X+XINTU 
RETURN 
END 


SUBROUTINE COWLCDPT) 

COiMHaN/.CG/JU/ ICOivL , MM , Xi^ C 9 ) # YM (9) , PM [9 } t ^ 3 f RHM ( 9 j , 7HM C 9 ) , um i 9) , 

1RM(9) ,TM(9) ,GM(9) ,XMUM(9),LMM(9) ,AUPM(7r93»CPXM(9) 
COMMQN/.IEQ/IEQ,PIN,RHOINF,UlNF,PINF 
COMMON/.VAR/RHOC200) r 

iEM(aoO) f XMU(200)fCPXC200) f tnaoo) f R(200 3 f GAMC200 3 ,XMASSC200) r 

2 XNC200),YNC2003 fQNC200) ,TNC 200 3 ,PN (200)# THN (200) rRHON 

3(200) r£MN(200) r XMUN(200) r CPXNCaOO) , WNC200 3 , RN (200) , GAMNC200 ) # 
4XMASSN (200) ,ALPN( 10,200) r SIC iO) # HI (10) fTEMP(20) 

5, AUPDUMCIO) 

COMMON XSP/ NSP 

COMMON/.X/ XC2Q03 ,Y (200) ,PC200) ,0(200) ,T (200) ,TH(200) , ALP Cl 0,200) 
COMMON/.A/ TIN,CPIN,RO 
COMMON/.D/ GAMINF,EMINF,R1NF, WINF 
CDMMON/.Ci/ EMC1,TC1,0C1 
C0MMQN/.IDEAL/IDEAL,GAMEY,XMWT ,CP1 
COMMON/.ICU/EMC2 
DO 4585 J"l,NSP 
4565 ALPDUM(J)=ALPMCJ,MM) 

I £R “ 0 
ITTsi 

BET=(THMCMM)-OPT*XMUM(MM) + THCn 3*1 r 1 
IFANsMM-*3 
3 CONTINUE 
lOEALSsO 
IEQS=IE0 
CPIS=CPIN 
GAMES=GAMINF 
XMWS=WINF 

IFCIOEAL.NE.UGDTO 717 

IOEALSsIDEAL 

GAMESsGAMEY 

CP1S=CPI 

XMrtS=XMWT 

717 CPI=CPIN*25, 02006*1, E + 05 
GAMEY=GAMINF 
IDEALsl 
IEQ=1 
XMWTsWiNF 
IIsMM-l 

CALL SHOCK (BET, QM (MM) , THM(MM) , GM(MM) , EMM(MM) , RHM(MM) , PM(MM) , 
1RM(MM),4M(MM),TM(MM),XMUMCMM) , 

2QMai),THM(II) rGMClI) ,EMMCII) ,RHM(II),PM(II) ,WMCII) , 
5TMCin rXMUMCII) ,ALPOUM, 1 ,, lEQ) 

XMUI) = XM(MM) 

YMai) = YM(MM) 

EMC2=EMMai) 

EMCi=EMM(H) 

00 4386 J=1,NSP 
4386 ALPM(v), II)-ALPDUMCJ) 

KK=II-1 
D»0 , 

call INTCO, ,XMCJI) ,YM(II) , THMCII) ,PM(II) ,QMCII)/RHMCII) ,RM(II>, 
IWMCII) ,GMCn),eMM(II),XMUMCII),TMCII), 

1D,D,D,D,D,D,D,D,D,D,D,D 

1,XM(KK) , YMCKK) , THMCKK) ,PM(KK) ,QM(KK) ,RHM(KK) ,RM(KK), WM(KK) , 

IGM(KK) ,EMH(KK) ,XMUM(KK) , TM(KK) , ALPDUM, 0, lEQ) 



■r 


lEQsIEQS 

IDEAU=IDEALS 

GAMEYsGAMES 

CPISCPIS 

XMWT“XVi/jS 

DPsCPCn-PMCim/FLDATCIFAN-n 
II = l 

DO 4387 J=l,NSP 

ALPMCJ, ii)=alpcj# n 
4367 ALPDUMC J)=ALP(J, 1) 

D=0* 

CALL INTCO,,XCl)f VCHf THCDf PCUfQCnrPHOCn^RCU^WCDf GAMU), 

iEM(i),xMucn,T(n, 

iOfDfDfDjOfOfDfDfOfDfOfD 

UXMCII) ^YMUn ,THW(II) f RMCII),wMCII) , 

1 GM(II},EMMCII) , X^^UMCII) rTMtll) , ALPDUMr 0 ^ lEQ) 

DO 12 LL-2fIFAM 

N=LL 

KK=M-1 

XM(N)=XM(KK) 

YMCN)=YMCKK) 

PMCNJsPMCKKl-^DP 
DO 4386 JslrNSP 
4388 ALPM(J,N)=ALPDUM(J) 

A = l. 

B»0 • 

call SL(PMCKK) ,QM(KK), RHMCKK) f RM(KK) , WM(KK), GMCKK3 ,EMMCKK) , 
IXMUMCKK) ,TMCKK),P(^(N),QM(N),RHM(N3,RM(Ni),WM(N)»GMCN),EMMCN)r 
IXMUMCN), TMCN) I ALPDUM,I£Q, A,B) 

Al = ,5* CGMCl^n/SlN CXMUM(W) )/COS(XMUMCN) ) +GM C KK ) /SI N C XMUM (K K ) ) /COS 
UXMUM(KK))) 

ALNR^ALOGtPMCfvn/PMCKK) ) 

THM(N) sTHMCKK) +OPT*ALNR/Al 
12 CONTINUE 

ERa = THVUlFAN)*THMaFAN + n 

IF(ABS(ER43.LT,l.E-04) GO TO 15 

CALL ERRdERr ITT, BET, ER4, 1,05/ BET 1 ,ER41) 

IFCIER.EQ.UGO TO 102 

ITT-ITT+l 

GO TO 3 

102 WRITE(6,203) 

203 FORMATC^ ERROR IN BETA LOOP IN COInL*) 

STOP 

15 CONTINUE 

rtRITE(6,85)BET 

85 FORMAT ax, E13, 5) 

WRITE CS, 86) tKfPMCK) ,QM(K) , TMCK) , THMCK) , RHMCK) , XMUM(K) , K=1 ,MM) 

86 FORMAT CIX, I5,6E13.5) 

RETURN 

END 


SUBROUTINE CDWLOU # THM, EM, BE Tp PMM J 


COMMON AF VAR/ 

1RHOFC200) / CPXF(200),EMF(200), XMUF (200) , WF C 20 0 ) , RF C 20 0 ) , GAMF ( 20 0 ) 
2XMASSFC200) f HFC200 ) SF (200 ; , ALPD C 1 0) , 

3THETAC20) 

COMMON/.XF/XFC200), YFC200) pPFCHOO) ,QFC200) ,TF(2Q0),THF(200) ? AUPF C 

no, 200) 

COMMON/.D/ GAMINF,EMINF,RINF,WiNF 
COMMON/.CI/ £MC1,TC1,QC1 
COMMON /SP/ NSP 
DIMENSION ALPDUM(IO) 

J-I + l 

B£t=THFCI)-XMUP (I) 

BET=BET- ,1*ABSCBET) 

ITT=1 

DO H JJsJfNSP 
H AUPDUMCJJ) =ALPF(JJ,I) 
lERsO 

3 CONTINUE 

CALL SHOCK (BET, QF(I) ,THF Cl) pGAMF (I ) , EMF C I ) r RHOF (I ) , PF C I ) , RF C I ) i 
IrtFCDfTFCI) f XMUF(I) ,OF(J) pTBFCJ) ,GAMF CJ),EMF(J J rRHOF (J), PF(J) , 
2RF(J),WF(J) ,TF(J),XMUF(J) ,ALPDUM,-1,, lEQ) 

P2=PFC j)*gaminf*eminf*eminf 
P2=P2/PMM 


TH25THF(J) 

CALL PRMCP2,THM,EMrTH2T,EM3,-l) 
£R4=TH2T-TH2 

IF( ABS(ER4) ,LT,l,£-04) GO TO 15 

CALL ERRCIER,ITT,BET,ER4, 1,05,BET1,ER41) 

IF(IER,EQ,i)6D TO 102 

STT=ITT+1 

GO TO 3 

102 WRIT£Cfa,203) 

203 FQRMATC* ERROR IN BETA LOOP IN CDWLO*) 
STOP 

15 CONTINUE 

DO 300 UJ=lrNSP 
300 ALPFCJJ, J)=ALPFCJJ,I) 

XFCJ)=XF(1) 

YFCJ)=YF(X) 

EMCUEM3 

DUMl = l, + CGAMINF-l.)/2,*EMINFi^EMINF 

DUM2=1, + (GAMInF-U)/2,*EM3*EM3 

TC1SDUM1/DUM2 

t)ClsEM3/EMINF*SQRTCTCn 

RETURN 

END 


‘ SUBROUTINE SHOCK (.BET, Q i , THl , G1 , EMI , RHl , PI , HI / PHI 1 , T1 , XMUi , 
lQ2,TH2..G?,E^-1^,RH2,P2,h2,PHI2, 72/ XMUar ALPDUf'*^ FSH, lEQ) 
COMMONAA/ TIN/CPIN,R0 
COMMO^i/D/ GAVjINF,EMINF,RINF/WlNF 
DIMENSION ALPDUM(IO) 

IT = 1 

IER=0 

VI=Q1*Q1 

HS1=H1*.V1/2. 

VT=QJ*C0SCBET-THI) 

U1=ABS(Q1*SIN(B£T-TH1) 3 
GMl=Gl-i , 

GPi=Gl+l. 

XMi=EMl*SINCBET<-THn 

XMS=RH1*U1 

IFCIT,EQ,1)UM5U1*(GMI*XM1*XM1+2,3/GP1/XM1/XM1 
7 ^H2=XMS/UM 

P2=XMS*CU1-*UM)4P1 

V2=VT*VT+UM*UM 

H2=Hi 

HS2=H2-V2/2, 

PH12=PHI1 

IFCIEQ.EQ.OIGO to 10 
RH2T=RHEQCHS2,P2, PHI 2,723 
ER=(RH2«RH2T3/RH1 
GO TO 12 

10 T2=P2*PHI2*GAMINF*EMINF **2/RO/RH2/WINF 
CALL THERMDCT2/HS2T,DUM,DUM) 

ER=CHS2T-HS2)/HS1 
12 CONTINUE 

IFCABSCER3 ,LT. 1 ,E-03)GO TO 9 
CALL ERRCIER,IT,UM,ER,,99,UM1,ERU 
IFCIER.EQ, 13GO TO 100 
ITstlTfl 
60 TO 7 ■ 

100 rtRlTE(b,200) 

200 FORMATC* ERROR IN HUGONIOT LOOP IN SHOCK*) 

WRlTE(6,^b3IEQ,FSH,BET,THl,Pi,Ql,Gl ,EM1,RH1 ,Hl,PHIl,Tl, 
lP2,UM,Ui , VT,RH2,T2,HS2,ER 
^6 FORMAT (IX, I2,9E13.B/3X, 10E13.5) 

STOP 

9 IF(FSH.GT,0.) TH2-B£T-ATAN(UM/VT3 
IFCFSH.CT.O,) TH2=ATAN(UM/VT)+BET 
Q2=S0RTCV2) 

CALL ALLCP2,Q2,RH2,PHI2,H2,G2,EM2,XMU2,T2, ALPDUM,IF.Q,i) 

RETURN 

END 


SUBROUTINE SHOCPT CIS/ M, BET r BETN, A , B) 

COMMON/, VAR/RHfiC^OO) , 

IEM(200) rXMU(200) rCPX(200) f WC2003 ,RC200)/GAM(200) ,XMASSC200D f 
2 XNC200) , YN(?00] , QN (20 03 # TN C200 ) , PN ( 20 0 3 , 1 HN C200 ) , RHON 

3(2003 , EMNC200)^ XMUNC20 0) , CPXN C200 3 1 ( 200 3 , RN C 200 3 ,aAMfU20 03 , 

4XMASSNC20 0) , AUPN ( 1 0 , 200 3 ^SI C 1 0 3 , HI (1 0 3 , TEMP (20 ) 

5,AUPDUVU103 

COMMON/X/ XC2003fYC2003,PC2003,Qt2003,T (200) , TH (200) , ALP ( 1 0 , 200 3 

COMMON/.ETX/XJ,XJ1,NPTS,IO,1REFL,ICHEM,IPUNCH,1DESGN,IR,NXX,XBP, 

1YBP,TH3P,RAD,XB0D,. Y8G0,THB0D,RADB,XEND, THEND,RTH, YEX I T , T HST , TEST , 
IIKFL, Y0,RAD82, RRAD(20) , NSTAR, YNOZ,EIN, PEN,H16,H17 
COMMGN/iEQ/IEQ,PIN,RHDINF,UINF,PINF 

iFCB.Ea.O,) a£TN=BET+CTHNnS-l)+XMUN(IS-U“TH(M-l)-XMUCM-i 3 ) 

i = IS 

J=IS+1 

Li=I5 

ITTsl 

IER=0 

DO 75 JJ=1,7 

75 ALPDUM(JJ3=ALPN(JJ,I3 

3 call SHOCK(BETN,ON(nrTHR(I3,GAMN(I3fEMNCI),RHDN(13,PNCn, 
lRN(I),yJN(I3, TN(I3 /XMUNCI3 ►ON(J) ,THN(J3 , GAMN ( J3 , EMN ( J ) , RHON ( J3 , 
2PN( J) ,RN(J) ,WN( J3 , TN( J3 , XMUN ( J3 , ALPDUM, I , , IEQ3 
EMlaXMl C ,5, *5, THN(J3 ,XMUN( J3 , TH(M) ,XMU(M) ) 

£M2=XM2C,5, ,5,THCM), XMU(M3 ,TH(M+n ,XMU(M+1 3) 
YDUM=CEMl*Y(M3»'EM2*YN(L3+tMl*EM2*tXN(L3-X (M) 3 3 / (EM1-EM2 3 
RAT-(YDUM"Y(M33/(V (M+1)-Y£M) ) 

IF(XS,EQ,2,A(MD,M,EQ,2) KAT = 0, 

call lNTCRATrX£M),Y(M),TH(M),P(M3 ,S(M) ,RHO(M3 , R(M) , W(M) , GAMCM3 , 
1EMCM3,XMUCM),T£M), X(M+13,Y(M+1),TH(M+13,P(M+U,H(M+1), 

2RH0CM+1 ) ,R(M+13 ,W{M+13 ,GAM(M+13 ,EM(M+1 3 ,XMU(M+l 3 , T (Mf 1 3 , 

3X2, Y2, TH2, P2,Q2, RH2,R2, I^J2,GAM2,EM2, XMU2, T 2, ALPDUM, I , lEQ) 

AlsFl £A,B, XMU2,GAM2,P2,XMUWCJ3 ,GAMNCJ),PN(J3 3 

A2 = F2(A,B, 1 , ,XJ,XJ1,X2, Y2,TH2,XMU2, XN(J) , YN £ J ) , THN £ J 3 , XMUN ( J 3 } 
DUMlsA2*CXNC J3-X2) 

DUMs£TH2-THNCJ3-DUM13/A1 
PTEST=P2*EXP£DUM3 
£R4=CPTEST*"PNCJ) )/P(M) 

IFCABSCER43 ,LT,1,E-043 GO TO 15 

call ERRCIER, ITT,BETN,ER4, 1,05,BETN1 ,ER41 3 

IF(IER,EQ,1)G0 to 102 

itt=itt+i 

GO TO 3 

102 WRITEC6,203) 

203 FORMATC* ERROR IN BETA LOOP IN SHOCPT*) 

STOP 

15 CONTINUE 
XN(J)sXN£I3 
YNCJlcYNCn 
DO 300 JJ=i,7 
300 ALPNCJJ, J3=ALPN(JJ, n 
RETURN 
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SUBROUTINE PRM(P,THUXM1 ,TH2,XM2, ISI 
COMMON/;j/ GAMINF,£MINF,RINF,WINF 
GsGAMI^jF 
GM1=G»1, 

GPlsG+l, 

DUMsl ,fGMl/2,*XMUXMl 
P=P**CGM1/G3 
XM2=CDU^1/P-1,)*2*/GM1 
XH2=SQRTCX'Vi2) 

GX-SQRT(GPi/GMl) 

DUMi = SQRT(XMl*XMl-.i , ) 

DUM2=SQRTCXM2*XM2-1 , ) 

DTH= GX*CATAN(DUM2/GX)^ATAN(DUMl/GX))+ATANC0UMn-ATANCDUM2) 

THH=TH1+FUJATCIS)*DTH 

RETURN 

ENO 


SUBROUTINE PR^^CP, THl , XMl , TH2, XM2, IS) 

COMMON/.:)/ SAMINF,EMINF,RINF, WiNF 

G=GAMXNF 

GM1=G-1, 

GPlsG+1, 

DUMsl , fGMl/2,*XMl*XMl 
P-P**(GMl/G) 

XM2s(DUM/P-U)*E,/GMl 

XM2=SQRTCXM2) 

GX=SQRT(GPI/GM1) 

DUMI = S9RTCXMUXM1-1, ) 

DUM2sSQRTCXM2*XM2-U) 

DTH= GX*CATAN(DUM2/GX}«ATAN(0UM1/GX) )+ATANCDUMl)-ATAN(0UM2) 

TH2sTHl+FLOATCIS)*DTH 

RETURN 

END 
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FUNCTiai\J FT(Pl,F,H51 
COMMON /.I PP/ IP? 

COMMON /THE/ A 1 , A2 , A3 / A4 r A5 , A6, XMM I 
C0MMaN/.I£Q/I£QrPIN,RHOIMF,UU4tSFINF 
CDMMON/.A/ TIN,CPIN,RO 
COMMON/.IDEAL/iOEAU,GAMEY,XMWT ,CPI 
DATA I£>3/0/ 

IFCIDEAL.EQ. UGO TO 6666 

IFLAGsO 

1H01-D=:0 

PsPl/PIN*PINF*l,01325E+05 

H=H5*UINF/10,7639/l,E+06 

F2=F*F 

A10=AL3GCP)/2,5-5, 

Z9s* 1H5* A10*Al 0 "WtSTB^AlO 

n=i 

lFa63*EQ.l) GO TO 1000 

163 = 1 

T=1500, 

T0=l500, 

IFCF.GEtO.) GO TO 120 
T=600, 

T0 = T 

1000 CONTINUE 

IF(F,UT,0.) go TO 400 
GO TO 120 
50 E0=CH-.H1)/H 

IF(ABSCEO) ,LT,i ,E-04) GO TO 340 
500 T =T0*l,l 
502 IT=2 

IF(F,LT,0,) GO TO 400 
GO TO 120 
100 EUCH-HD/H 

IFCABSCEU.lt, l,E-04) GO TO 340 
IT=IT+i 

IFCIT,LT.2U GO TO 10 
IFCABSCT"2000,),LT.10.1 GO TO 630 
IFCIHOUD.EQ.O) GO TO 800 
NRITEC6,83U PUH5,T 

831 FOKMATC* ERROR IN FT*/* PI = *E 1 3, 5 , 5X, *H 1 = *E13,5,5X/*T 
U 

STOP 

800 T=TH0L0 
T0=T 
HsHHOLD 
IT=1 
IHOLD=l 

IFCT,LE,2000U IHOLD=-l 
GO TO 1000 

830 IFCIFLAG.EQ,!) GO TO 504 
IFLAG=1 
T0=2000, 

TS2000, 

IFCF.LT.OU go TO 400 
GO TO lao 

504 WRITEC6,li) El 

11 FDRMATC* TEMPERATURE IN FT SET TO 2000 - ERROR = 


= *E15,5 


*E13,55 



GO TO 340 

to T 9 iT 0 »E 3 #iCT “T 0 )/Cti -£03 
505 EOrEl 
TOST 
TST9 

IFCF,LT, 0 .) GO TO 400 
120 A=l,E- 07 *(-, 1042 *F 2 +, 8242 *F* 5 -, 967 ) 

Bs, 00 l*C, 01167 *F 2 +. 1503 *F+, 93 B) 

Cs-, 0284 *F 2 +, 6751 *F +,4293 
IF(F,LE,U) GO TO 190 
As 1 ,e;- 07 *CU 787 *F 2 - 5 , 48 *F + 5 , 4 ) 
Bs, 001 *C-.i 867 *F 2 +l.ll*F+ "' 6 ) 

Csp.,0935*F2 +3,975*F-2,80B 
190 IFCT, LE, 2000 , .AND. IHOLD.NE.n GO TO 290 
As,000001*C1,792*F2 + , 3985*F + , 3 1 ) 
Bs, 00 l*C-' 9 , 05 *F 2 - . 079 1 7 *F+ . 245 ) 

Cs 1 o,B 6 *F 2 -,ll 83 *F +,97 
IFCF.LE.l.) GO TO 290 
As,o 00001 *C 4 , 81 *F 2 - 13 . 9 *F+ 11 , 59 ) 
Bs, 001 *C’- 23 , 08 *F 2 + 66 . 82 *F- 52,61 ) 

C= 27 , 05 *F 2 - 73 , 73 *F+ 58,39 
290 HlsA*T*Tf 6 *T+C 

IFCT. LE. 2000 . .AND. IHDLD.NE.U GO TO 370 
Hl=Hl*Cl,+ei,+F)*(T/ 2000 ,-l . )*Z 9 ) 

370 CONTINUE 
GO TO 350 
400 T 2 sT*T 
T 3 =T 2 *T 
T 4 =T 3 *T 
T 5 =T 4 *T 

1 F(F.LT,- 1 , 5 ) GO TO 450 
XMNtlslfo,043 
Ai= 4, 2497678 
A 2 s« 6 , 9126562 E -03 
A 5 = 3 ,i 602134 E -05 
A 4 =» 2 , 9715432 E -08 
A 5 s 9 , 5103580 E -12 
A 6 s.»l b 0186632 E +04 
GO TO 460 
450 continue 

Alsl . 1202436 

A 2 = 1 , 3905716 E -02 

A 3 s 2 , 6568374 E -06 

A 4 =- 1 , 1560272 E -08 

A 5 = 5 . 2386929 E -12 

A6=5,3528a96E+03 

XMMIS28.054 

460 HlsAl* r + A 2 *T 2 / 2 . + A 3 *T 3 / 3 ,+A 4 *T 4 / 4 ,+A 5 *T 5 +A 6 
HUHl* 8314 ./XMMl/l,E +06 
350 IFCIT.EQ.l) GO TO 50 
GO TO 100 
340 T 0 =T 

FT=T/TIN 

THDLDsT 

HHDE 0 =H 

RETURN 

6666 HsH5* UINF 


FTsH*5,/9t/CPT/TIN 

RETURN 

END 


FUMCrUlN FHCP1,F,T1) 

C0<^1M0N /THE/ ,A2,A3, A5, Ab^XMMl 

cdmmon/.ieq/ieq,pin,rhoinf,uinf,pinf 
COMMO^^/.A/ TlM,CPI(\t,RO 
COMMON/.IDEAL/IDEALjrGAMEY,XMWT fCPI 
T55TUTIN 

IFCIDEAU,EQ.1)GD to 6666 

P=Pi/PIN*PINF*i.01325E+05 

F2cP*F 

IF(F,LT,0.) go to UOO 
IFCT,6T,2000,) GO TO 190 
IFCF.GT.U) GO TO 191 
120 A=i,E-07*(*-. 1042*F2 + , 82a2*F + ,987) 

8=,001*C .01167*F2 F, 1503*F+.93B) 

C=-,0284*F2 +,6731*F+,4293 
GO TO 290 

191 A=i,E*-07*Cl,787*F2 -‘5,48*F^5,a) 

1867*F2 + 1 . 1 1 *F + , t 76) 

C=-,0933*F2 +3,975*F“2,80B 
GO TO 290 

190 IFCF.GT.K) go to 192 

A=,00000l*(l ,792*F2 +,3983*F+,31) 
es,00lv^(-9,05*F2 -.07917*F+,245) 

C=10,86*F2 -.llB3*F+,97 
GO TO 290 

192 A=,00000i*(4,31*F2 ^1 3 . 9*F+ 1 1 , 59 ) 
B=,001*(-23,08*F2 +66,62*F^52,61 ) 

C=27,05*F2 -73,73*F+58,39 

290 Hl-A*T*T+a*T+C 

IFCT.LE,2000.) GO TO 370 
AlOsALOGCPJ/a.S-^B, 

Z9 = , 125*A10*A10 <p,275*AlO 

Hl = Hl*Cl. + Cl,+r)*CT/200 0,-U)*Z9) 

370 Hl=Hl*l,E+06 
GO TO 340 
400 T2=T*T 
T5=T2*T 
T4=T5*T 
T5=T4*T 

H1=AI*T+A2*T2/2,+A3^T3/3,+A4*T4/4,+A5*T5+A6 
HlcHU8314,/XMMl 
340 CONTINUE 

FH=Hl*i0.7639/UlNF 

RETURN 

6666 FH=CPI*T*9,/5,/UINF 
RETURN 
END 


FUNCTION FGAM^T^,P1^F5 

COMMON /THE/ Alf A2,A3.-A£|^ A5r A6,XVM1 

COMMDN/.IEQ/IEQ,PIN,RHDINF,UINF,PINF 

COMMON/.A/ TlNrCPIN,RO 

CDMMON/.I DEAL/ IDEAL, GAME V,XMWT ,CPI 

IFCIDEAL,EQ.1)G0 to bbbb 

TsTUTIN 

T2=T*T 

P=Pl/PIN*PINF*l,01325E+05 

XMsO, 

IF(F.LT.0,) go to 550 
IF(T,LE,1000,) GO TO A40 
XMs;-2, 15E-08*T2 +.000091*T-,0695 
440 XN=4,£-09*T2 00002*T-, 019 

IF(F,LE,le) GO TO 470 
XN=,0339*SQKT (T)-,0 00391 *T-, 681 
470 G5*-1,633E-07*T2 + , 000075*T+ 1 .367 
1F(T,LT,500,) GO TO 520 
G=2,E-08*T2 -^.OOOlSB^T+l ,423 
IFCT,LT,2000.) go to 520 
Gs7,267E»»0a*T2 -^jOGOAET^T + i ,85 
520 G=G+XM*(ALOGCP)/2,3"5,) ^XN*(F-l,5 
GO TD 530 
550 T3=T2*T 
T4=T3*T 

CP=AltA2*T+A3*T2+A4*T3+A5*T4 

G=CP*(CP-l,) 

530 CONTINUE 
FGAiM=G 
RETURN 

6666 FGAM=GAMEY 
RETURN 
END 


FUNCTIQM RHEGCH,P1 ,Ff T) 

C0^1^i0^J/.IEC/IEQf PINrRHOINF,UlNF,PINr 
CaMMON/.A/ TINrCPINfRO 
COMMOl'i/iDEAL/IDEAL,GAMEY,XMwT rCPI 
Tl=FT<Pi,F,H) 

T=n*TIN 

IFaDEAL,En.t)GO TO 6666 
P=P1/P1N*PIWF*U01325E + 05 
IF(F.UT,0,} GO TO 2260 
FNM=l,53*F*F-5,895*F+28,965 
FNMsl,b*F*F"10t8^F+33,6 
1FCT,GT,2000.) GO TO 2030 
XMsFNM 

IFCF.LT.l.) GO TO 2160 
XMsFNN 
GO TO 2160 
2030 FF=F*F 

As-2,3*FF+4,01*F + U736 

A=8,6l*FF-15,a2*F-6,66 

u3»16tB8*FF+33t21*F+14*58 

XN=-,4375*FF+,0625*F+2.08 

DiA*(AL,OGCP)/2,33**l ,5 + B*CALDG(P)/2,3)+C 

XM=FNM-D*C ( T-2000.)/iOOO,3**XN 

IFCF.LT.l.) GO TO 2160 

A=^,822*FF+2,363*F+1.905 

B=2,76*FF-7,56*F“8,6B 

C=-3,6*FF+7 .36*F+27,15 

XN-**.47*FF+1 .825*F + ,35 

D=A*(ALDGCP)/2,33«*1.5+B*CAL0G(P)/2,3)+C 
XM=FNN-D*C (T-2000, )/i000,3**XN 

GO TO 2160 
2260 KF=F^,5 

IFCKF,EQ,-nXM=l6,oa3 
IFCKF,EQ.-2)XM=28,054 
2160 RHEQ=P*XM/T/83l4,3*6.2428E-02/32, 174 
T=T/TIN 

RHEQsRHEQ/RHQiNF 

RETURN 

6666 RhfcQsPi*XMWT*5.*UINF/T/9,/49712,52 
T-T/TIN 
RETURN 
END 


SUBROUTINE ERRORCIIII) 
WRITECbflOO) mi 
100 F0RMATC7H1EKR0R=I5) 
CALL EXIT 
RETURN 
END 


FUNCTION XMl ( ALPHA , BETA, T A, XA, TC, XC) 
Xrn=AUPMA*TANCTA+XA) 
IF(BETA,GT,0,)XM1=XM1+BETA*TANCTC+XC 
RETURN 

end 


FUNCTION XM2CAL,B,TArXArTC,XC) 
XM2 sAI.*TAW(TA^XA) 
IFC8,GT,0,)XM2sXM2+B*TAN(TC-XC) 
RETURN 

end 


FUNCriDN XM3CA,B,TD,TC) 
x«3=a*t;uvvt;>} 

IFCB,5T,0.0)XM3=XM3+B*TAN(TC) 

RETU«fJ 

END 



FUNCTION FICA, B, GAMlj Pir 5CMU2, 

IGAM2, P2) 

Fl=SINCXMUn*COS(XMUl)/GAMl 
IF(a,BT,0,0)Fl = CFl+SINCXf^U2)* 
lCaS(XMUa)/GAM2 )/2, 

RETURN 

END 


FUNCTION F3CA,BrOPTf Xj,'XJl,X,Y,TH,XMU,XNf YN,THN/XMUN) 

r2i=o, 

IFCXJoEQ,0,} GO TO 15 

F21=A^SIN(TH3*SIN(XMU3/C0S(TH+DPT*XMU)/Y 

IF(B.GT,0,3 F21=;F21+B*S1NCTHN)*SIN(XMUN)/CDSCTHN+0PT*XMUN)/YN 
15 F22=0, 

IF(XJ1,EQ,0.) GO TO 10 

F22sAjtCOSCTH)*SIN(XMU3/CDSCTH+OPT*XMUl 

IF(B,GT , 0, J F22~F22+B*CDS CTHN)*SINCXMUN)/COSCTHN + OPT *XMUN) 

10 F2SF21+F22 
RETURN 
END 


SUBROUTINE DRIEST CXN, YW,EMt , BET, IDROPrL,W3 

common/^/ XC2003 f YC200)^PC200 3 .0(200 I ? T C200) r TH( 20 0 3 AtP C 1 0,200 ) 
EM2=TANCBET) 

XNT=CYCM)-YCM+L)’-EMl*X(M)+EM2*XCM+U 3/CEM2-EM1) 

YNT=Y(V13+EMI*CXNT-X(M) 3 

DISN0R = 5«RTC CXNwXCMJ 3**2+(YN-YCM) 3**2) 

DISEX =S0RTCCXNT-XCM))**2-KYNT-YCM) 3**23 

if((disex-disnor)/d3sex,lt,,u I drops i 

RETURN 

END 



SUBRDUTINfc XMASSSCRATM, NPTS5 
COMMONX.FVAR/ 

IRHUF E200) rCPXFCaoO) ,EMF(200), XMUF CEOO) f WFC200)f RFCaOO) fliAMF C200) 
2XMASSF(200] , HFC200) ,SF(200) , ALPD(iO) , 

5THETA(20) 

COMMON/;<F/XF(200) r YFC200) rPF(2J03 ,QF(2003i TF(200) f THF (200) , ALPF( 

110 , 200 ) 

DO 170 I=1,NPTS 

CAUL F^ CFMl,EMr(l),GAMFCn) 

FM2=FM1/RATM 

ITM=1 

X£R=0 

EMT=RATM*EMF(I) 

197 CONTINUE 

CALL F'^CFMTrEMTrGAMFCD) 

ERM=(FM2-FMT)/FM2 

IF(ABS(ERM) ,LT, 1*E-03)GO TO 171 

DUMD=i ,/RATM 

CALL ERRCIERf ITM,EMT,ERM,DUMD,EMT1,ERM1) 

IF(IER,EQ,1)G0 TO 2 

1TM=ITM+1 

BO TO 197 

2 WRnEC6,3) 

3 FORMATC* ERROR IN ITERATION LOOP IN XMASSS*) 

STOP 

171 CONTINUE 

DUMsSQRTC CGAMF(I) + 1 ,)/(GAMF(I)-l ,)) 

£TS0=SQRT(EMT*EMT-1 * ) 

ESQsSQRT(£MF(I)*EMF{I)-l ,) 

XNU2=0UM*ATAN(ETSQ/DUW)-ATAN(ETSQ) 

XNU1=0UM*ATANCES0/DUM)-ATANCESQ) 

0NU=XNU2«XNU1 
CALL PM1(DNU,I) 

170 CONTINUE 
RETURN 
END 




SUBROUTINE THERMDCTI,H,CP,DCP) 

COMMON/i E Q/ T E Q , P I N , RHO U'F , U I NF , P I NF 
COMMON /SP/ NSP 
COMMON/^/ TIN,CPIN,RO 
COMMON/,B/ WTMOLE 
DIMENSION ^VTMOLECIO) 

DIMENSION HC103 ,CP(10) rDCPUO) 

T=TI*nN 

Cl=RO/CPIN 

C2SC1/TIN 

C3=C1*TIN 

N=NSP 

DO 10 J=lfN 
H1=C2//^TM0LECJ) 

H2=C1//^TMDLECJ) 

H3=C3/rtTMOLECJ3 

call. C3EFF(JrT,A,B,C,D,E,F,G] 

H(J) = T*CA+r*(B/2.-fT*CC/3,+T*(D/a,+E/5,*T) J )3+F 
= J)*RD*4,B0 6557*l,E + 0i:j/WTMOLE( J)/UINF 

CPCJ)=AfT*CB+T*CC+T*CD+E*T))3 
CPCJ)=CPCJ)*H2 

DCPCJ)=B+T*C2,*C+T*C3,*D+^,AE*T) 3 
OCPCJ3=DCP(J3*H3 

10 continue 

RETURN 

END 


SUBROUTINE SL CP 1 , 01 , RHi , R i , 1 , GAMi . E^Al .XMU1,T1^ 
lP2,Q2,RHc,R^i,rt2,GAM2,EM2,XMUaf 12i ALPUUM, lEQ, A,B) 

R2sRl 

RH2=RHi*CP2/Pl)**(l,/GAMU 
IrCIEQ.tQ, n W2=W1 

IFCIEQtEQ.l ,AND,B,EQ.O.)Q2=01+fPl^P2)/RHl/GU 

call ALLCP2^Q2,RH2rR2,W2/GAM2,EM2,XMU2,T2/ALPDUM,IEQ,0) 

RETURN 

END 


SUaRDUTINE DP0INT(K,trM,N,NPTS,A,8) 

COfJIMON/.X/ XC200) , Y(20C) ,PC200) fQC^OO) jTCaOO) ,TH(200y# ALPt 10,£;u0) 

COMMQNt/.IEQ/IEQ,PlN,RHDINF,UINF,PINF 

COMMON/.VAR/RHOC200 3 , 

lEf^(200)j XMUC200) ,CPXC2003 f rtC200 ),RC200) ,GAM(20 0),XMASS(20 03 , 

2 XNt200),VN (200), QN( 2003 , TNC200),PN (2003 r THN C 20 0 3 , RHON 

3(200 3, EMNC 200), XI^UN (200 3 ,CPXN (2003 ,WN (2003 ,RN (2003, GAMN (2003, 
4XMASSN(20 0 3 , ALPN( 10,200 3 ,Sia03,HlUO) ,TEMP(20 3 
5,ALPDU^n03 
COMMON /SP/ NSP 

COMMDN/.DD/XD, YD,THD,PD,QD,RHD,RD, WD,EMD,GAMD,XMUD,TD 

ITD=0 

IF(M,EQ,nGO TO 195 
XD=.5*CXCM)+X(M«l)3 

SLO=,S*CTANCTHNa33 + ,5*(TAN(THCM3 )+TAN(TH(M-,n 3 33 
QDkQ£M*-13 

SLMsCY(M3-Y€M-n 3/(X£M)^X(M-13 3 

S2=SQRTC CXCM-U-X(M3 3**2+ (Y(M-13-Y (M3 3**2) 

10 CALL G£MCXNCL),YN(L3,SLD,XCM3,Y£M),SLM,XD,YD3 
SD=5QRT( CXD-X(M) )**2+(YD-YCM)3**23 
1FCITD,GT.03GQ TO 11 

IF(S[>,GT,S2)GO TO 100 

11 RATD = U*SD/S2 
XT=XD 

THD=THCM-13+RAT0*(THCM)^THCM-1) 3 

XD?X£M-13+RATD*£X(M)-X(M,.13 3 
ERD=ABS£ (XT-XD)/CXCM)-X(M<»1)3 3 
1F(ERD,LT, I .E-033GO TO 15 
SLDs£TANCTHNCL3 3+TAN£THD)}/2, 

ITD=ITD+l 

IFCITD.LT. 103GO TO 10 
WRlTECfa,753 

75 FORMATC*TOO MANY ITERATIONS IN DPOINT*) 

WRlTECb, 76)K,XNCK3 , YN(K) ,THN£K) ,XO, YD,RATD,THD ,ERD 
rtRITE(b,763L,XNlL3,YN(U ,THN(L) 

WRITE(6,763M,X(M),YCM3 ,TH(M) 

IFCM.GT, 1) JJ=M-1 

IFCM,Gr.l3WRITE(6,76)JJ, XCJJ3,YCJJ),TH(JJ3 

76 F0RMATC1X,I5,8E13,5) 

STOP 

15 DO 14 J=1,NSP 

14 ALPDUM(J3=ALPCJ,M<-1 )+RATD*C ALP CJ,M 3-ALP 3 3 

CALL INT(RArD,X(M-i3,Y(M-n,THCM-13, P (M-l) , Q (M- 1 ) , RHO (M-1 3 , 

IRCM-l 3 , wCM-1 3 ,GAM£M-1 3 ,EMf M-13,XMU£M-1) ,T(M-13,X(M) , Y(M) , TH(M) , 

2P CM), Q (M3 ,RHO CM), R(M) ,W CM) ,GAM£M) , EM (M3 , XMUCM) , T (M) , 
301,D2,TH0,PD,Q0,RHD,RD,WD, 6AMD, EMD, XMUD , TO, ALPDUM, 1 , lEO) 

RETURN 

too CONTINUE 

SLP=CYNCK3-YCM-1) 3/CXNCK3-XCM-13 3 

SLD=,5*CTaNCTHNCL3 3 + .5*CTAN(THNCK) )+TAN£TH(M-U) 3 ) 
XOs.5*(XN(K3+X(M-n3 

iOl CALL GEM(XNCL)rVN(L),SLD,XN(K),YNCK),SLP,XD,YD3 
RATO=(XD-XCM-n3/(XN(K)-XCM-13) 

XT = XD 

THD=THCM-13+RATD*CTHNCK3-THCM-1)3 
XD=X(M-13 + RATD*CXN(K3-X CM- 13 3 
£RD = ABS( (XT-XD)/CXN(K)-XCM-13 3 3 


IFcet^D.LT- i,b-03)GO TO i50 
SLO=n ANCTnnjCU )+TANCtHD) )/2. 

ITDsITD+1 

IFaTD,L.T,10)GO TO lOt 
rtRITE(6,7b) 

STOP 

150 DO 140 JslrNSP 

1«0 ALPOUMC J)=ALPC Jf M-1 )+RATD*( ALPNC J,K)-ALP C JrM-1 } ) 

CALL iNTCRATDrXCM-DfYCM-’UrTHCM-lK P ( M- 1 ) , Q ( M- n , RHO (M- n » 

IR(M*U , W{M-U,GAHCM-^n ,EM(M-n , TC^-Dr 

2XN(K), YNCK3 ,THMCK) ,PN(K) ,ONCK),RHOMCK) rRNCK) ,WNCK) ,GAMf^CK) , 

3EMN(K) ,XMUNCK}, TNCK) ,D1 ,D2f THDf POfQD,RHDf RD,vND,GAMDf EMD, XMljOf 
4T0, ALPDUM, 1, lEQ) 

RETURN 

195 CONTINUE 
QDsQCM) 

SLD=,5*CTANCTHN(L))+.5*(TAN(THN(K} )+TAN{TH(M) ) ) ) 

X0=,5*(XN(K)+XCM)) 

175 = 0 

IFCABS(XNCK)^X(M}),GT, 1 ,E-^06)I75 = i 
IF(175,EQ,nG0 TO 290 
X0=CXNCK)+XCM1)/2, 

191 1FCI75,EQ. UGU TO 290 
Y0=YN(L)-SLD*CXNCL)-XD) 

GO TO 291 

290 5LP=(YN(K1"Y{M3 3/CXNCK)«XCM) ) 

CALL GEM(XNCU , YNCL) ,SLD# XNCK) ,YN(K) ,SLP,XO,YD3 

291 RATD = {YD-YC^>^))/(YN(K)-Y CM)) 

YT=YD 

THD=TH(M)+RATD*(THN(K)-TH(M) ) 

YDsYCM)+RATD*CYNCK)-YCM) ) 

ERD=CYT-YD)/CYN(K)-YCH)) 

IF(ABSCERD) ,LT,1,E-03)GO TO 197 
SLD=(TANCTHD)+TAN(THN(L))) /2, 

ITD=IT0+1 

IF(ITD,LT,10)GO TO 191 
WRITECSf 75) 

STOP 1 

197 DO 198 J = UNSP 

198 ALPDUMC J)=AUPCJf M)+RATD*CALPN[ J?K)-ALPC J..M) ) 

CALL INTCRAID/ X(M) , Y (M) ,TH£M) ,PCM) r«(M) ,RHO(M) ,R(M), wCM) rGAMCM ) , 
lEM(M) ,XMU(M) ,T(M) ,XN(K) ,YNCK) rTHN(K) ,PN(K) ,QNCK) ,RHON(K) ,RN(K) , 
2rtN(K) , GAMNCK) ,EMN(K ) , XMUN(K) , TN ( K ) , D 1 # 02 # THD , PO^ QD , RHD , RD , rtD / GAMD , 
3£MD,XMUDf TD^ALPDUM, 1, lEP) 

RETURN 

END 


SUBROUTINE I NT (HAT , X 1 , Y 1 , TH 1 tPi ^ Q1 , RHl , R 1 , Wl , GAMl , EM I , XMUl , T 1 » 
i X2, ya, TH2^ P2, C!2,RH2, P2p GAM2, EM2, XMU2, T2, 

2X3, Y3, TH5,P3,Q3,RH3,R3,W3,GAM5,EM3,XMU3, T5, ALPDUM,IALLf lEQ) 
DIMENSION ALPDUMdO] 


X 

3=X 

1+RAt*CX 

2”X 

n 

Y 

3=Y 

1+RAT*(Y 

2-Y 

n 

T 

3 = T 

l+RAT*(T 

2-T 

1 3 

P 

3 = P 

HRAT*(P 

2-P 

n 

R 

3=R 

ltRAT*(R 

2-R 

13 

1^ 

5=W 

1+RAT*CW 

2-W 

n 

Q 

3=Q 

1+RAT*CQ 

2-Q 

u 

TH 

3 = TH 

i+RAT*(TH 

2-TH 

13 


GAM3=GAM1+HAT*(GAM2-GAM1 3 

PRG1=PI/RHH*GAM1 

PRG2=PRG1 

IF(RAT,Nt,0, )PRG2=P2/RH2**GAM2 
PRG3=PRGi+RAT*(PRG2-PRGl 3 
RH3=CP3/PRG3) a*CU/GAM3) 

IFCIALL,EQ.13G0 TO 20 
EM 3=EM 1+RATaCEM 2-EM 13 
XMU3-XV1U1 + RAT*(XMU2-XMU1) 

RETURN 

20 CAUL AULCP3f Q3,RH3,R3^ W3fGAM3,EM3,XMU3, T3,AUPDUM,IEO,03 
RETURN 
END 


SUBROUTINE ERR (I, I T, X, ER , F/ X 1, ERi) 
lF(ITeUT,lS)i;u TO 12 

RETURN 

12 IF(IT*GT,2)GO TO iU 
ER1=:ER 
XlsX 
Xsx aF 

IFCX,EQ.X1}X-Xt,02 

RETURN 

14 XD=Xl-ERl*(X’»xn/(ER-ERi} 

ER1=ER 

XUX 

X=XD 

RETURN 

END 


SUBRnUTINH VIS(T,XMUU} 

C DiviKtO N / Ti tv r c P I f\i , RO 
TC = 19S,*5,/nN/9, 

XMUU~U* + TC)*CT**1 ,5)/(T + TC) 

RETURN 

END 


SUBR ’UTINE i/^liZZYfMr NPTS,KMAX#LK!AX* JPP, IFZ/LWUZ) 

C 0 M M . N / ,u D 0 rt N /LOO W K 
COMMON AICMPLT/ I CMPLT 
COMMON/.VAP/RHOC200} , 

1EMC200) # XMUC200 3 fCPXCSOO) ,wC200},R(aO0) ,GAMC200) ,XMASSC200) , 

2 XN(200) , YNC2003 ,QN(200) ,TNC2003,PNC200), THN(200),RHON 

3C200) ,EMN(200) , XMUN CPO 0 ) , CPXN C20 0 3 , WN C200 3 , RN ( 200 ) , GAMN C 20 0 3 , 
4XMASSNC2003 f ALPNCl0r200 3 rSI Cl03fHI(i03/ TEMPC203 
5r ALPDUMC103 

COMMON/;(/ XC2003 ,Y (200), PC2003 »QC2003 fT (2003 fTHC2003 fAUPU 0,2003 

LS=2 

L=2 

Ksl 

SLP1=:TANCTHNCK3+XMUN(K3 3 
M=3 

1F(N,LE,NPTS3M=1 

lFaCMPLT,EQ,2)Ms2 

A3 IF(K,GT, 13SLP1 = (YN(K3-YCM-13 3/CXNCK)i*X(M-l3 3 
IF(IFZ,EG,UAND,L,EQ.LD0WN3RETURN 
SUP2=CYNCL3-'YCM3 3/(XN(U)-XCM3 3 
39 CONTINUE 

IFa,EQ,LWUZ3RETURN 

iF(ABS(SLP 2 -SLP 13 .LT.l,E-»063Ga TO 40 

CALL GEMCXNCL3,YNtL3 ,SLP2,XN(K3 , YN(K),SLP1 ,XS,YS) 

IFCXS,IT,X.N(L)3G0 to 40 

IF((XS-XN(L3 3/(XNCL3-X(M) 3 ,GT,2,53GO TO 40 
IPT=IPP+1 

BETAS, 5*(SLPl+SLP23 

WRITE (6, 103IPT,L,K,M,L5,N,NPTS, 

1 XNCU3,X(M3 , XN(K) ,XCM-n , YNCU3 , Y(M3,YNCK3 , 

iYCM*13,SLPl,SLP2,BETA,XS, YS 
10 FORMAT(lX,7i5/lX,8U3,5/lX,6E13,5) 

WRlTE(b,333 

35 FORMATC * UP RUNNING SHOCK DETECTED * 3 
WRITE (6,343 IPT,LS. XS,YS,BETA 

34 FORMATC* LINE NO, “ *,I4,4X* POINT NO, = *,I4 ,4X*XS = *,E13,5, 
iilX* YS = *,E13,5,4X» SHOCK ANGLE = *tEl3,5) 

LL=L 

LMsLMAX^-1 

IF(L,EQ,LMAX)LL=LM 
DO 46 J=LL,LM 
XN(J3=XN( J+1 3 
YNCJ3=YNCJ+1 3 
PNCJ3=PNCJ+13 
QN(J3=QNCJ+1 3 
TN(J3=TN(J+13 
WNCJ3=WNCJ+13 
RN(J3 = RN(J+U 
THNCJ3=THN(J+1 ) 

EMNCJ3SEMNCJ+1 3 

RHUNCJ)=RHON(J+13 

XMUNCJ3=XMUN(Jtl) 

DO 1500 JL=1,7 

1500 ALPN(JL,J3-ALPN(JL,J+1 3 
46 CONTINUE 
LMAXsLMAX-1 
LSsLS^l 


MkH+1 

no k ^ k +1 
U=L+l 
MsM+i 
LS=LS+1 

lFa,LT.UMAX3G0 TO Hi 
IFCL,GT,LMAX)RETURN 

IFCIFZ.EQ, I, AND.L.EQ.LDOWNJRETURN 

M=KMAX 

K=L**1 

SLP1=(YNCK)-YCM)5/CXNCK5-XCM;) 
SLPa=TAI^CTHNCU + XMUNCU ) 

GO TO 39 
END 



SUBROUTINE FUZZYCK,Ur^^#Nf LMAX,KMAXrNPTS,IPP/ IFZ) 

COMMON/LOOv^N/UDOWN 

COMMON/.YAK/RHO(200) , 

lEMcaOO) #XMU(aOO) fCPX(POO) .RC200) rGAM(2003 ,XMASSC200) , 

2 XNC2003 ? YNC200) f ONC200) , TM(200) /PN(200} , THNC20 03 , RHDN 

3(2003 rEMMC 200) fXMUNC200 5 /CPXM (2003 ,WNC200) fRN (20 0),GAMNC20 0)f 
4Xf’1ASSNC200),ALPN(10p20 0),SI (10) ,HI (10), TEMPC20 3 
5,AUP0UM(10) 

COMMON/// X(200),Y(200),PC200),Q(200),T(200),TH(200), ALP (10,200) 

COMMON//CONL/XCOWL 

IFZ = 0 

DUMX=CXN(i)-X(I)3*‘*2 
0UMY=(yN(l)-Y(13 )**2 
TEST=SQRT(DUMX+DUMY) 

IF(TEST,E0,0,)R£TURN 

SLP=iTAN£THCM)+XMU(M)) 

SLM=TAM<THN(K)^XMUN(K) 3 

CALL GEM(XN(K) ,yNCK)rSLM,X(M), Y(M),SLP,XC, YC3 

DX=(XC-X(M))*a2 

DY=(YC-YCM) 3**2 

DCsSORT (DX+OY) 

IF ( CDC/JEST ) .GT, 0.23 RETURN 

LM=LMAX-1 

LDOWNsiL 

1=L 

J=M 


85 


1500 


^15 


33 


in 


XMUN(I): 

:XMU 

(J) 

YN 

(I)sY( 

CJ) 


X 

N(I) 

:X 

CJ) 

P 

NCI) 

:P 

CJ) 

Q 

N(I) 

sQ 

CJ) 

T 

N(n-T 

(J) 

W 

NCI)! 

= W 

CJ) 

R 

N(I)sR 

CJ) 

TH 

N(I): 

=th 

CJ) 

EM 

NCI): 

= EM 

CJ) 

RHONd): 

sRHO 

CJ) 

GAMNCI)! 

= GAM 

CJ) 

DO 

1500 

JJ = 

1,7 

ALPN(JJ, 

fI) = 

ALPCJJ, J) 

Is 

I + l 



Js, 

J + l 



IF 

CI.GT, 

»LM) 

GO TO 45 


GO TO 85 
CONTINUE 
IPT=XPP+1 

BETA=,5* (TAN(TH(M)-XMU(M))+5LM) 

WRlTE(fe,33) 

F0RMAT(* down running shock DETECTED * ) 

write (6, 343 IPT,L,XC,YC,BETA 

FORMAT(* LINE NO, = *,I4,4X* POINT NU, = *,I4 


14X* YS = *,E13,5,4X* 
LMAX=LMAX+1 


SHOCK ANGLE = *,E13.5) 


,4X*XS 


*,E13,5, 


IFCN,GT,NPTS)UMAX=KMAX-1 

IFZ=1 


RETURN 

END 


SUBROUTINE GNURECRH, Q, P, T, W/R# AlPDUM, X, X 1 , CF , ST, L) 
C0MM0N/.H0T/ftHC3) ,BHC3J ,Cm5;,XCTR,Pi;,REC,RElN,RT,SH, IT, 
COMMDN/.SP/NSP 

COMMON/.! EQ/ 1 EO, PIN, RHDINF,UINf-',PINF 
DIMENSION AtPDUMClOJ ,H1 a03 ,CP1 CIO) 

HDEL=R-Q*Q/H, 

HArt:;l.+REC*Q*Q/2,/HDEt 

IF (IT .EQ,0)Tw-AH(L)*(X-»xn**2+BH(U)*CX-Xn+CHCL) 

IFCIT ,EQ,l)GO TO 
IF(IEQ,EQ,0)GO TO 13 
H^=FH(P,rt, TW)/HDEL 
GO TO ae 

13 CALL THERH0CTW,H1,CP1,DUM) 

DO 20 J=1,NSP 
HWsHW+ALPDUM(J)*H1 CJ5 

20 continue 

HW=HW/HDEL 
GO TO £t8 
^6 Hrt'=HAW 
48 AsHAW^l, 

C=SQRT( (A+B)**2+4,aA) 

FCsA/CASINC CA-»B)/C)+ASIN( CA + B)/C) )**2 
FRX=HAW**C ,772)/(FC*(HW)**C 1 ,474) ) 
call VISCT,XMMU) 

REX=RH*Q*CX+X3TR)/XMMU 

REXIsFRX*REX*REIN*RT 

CFl3,OB8*CALOG10(REXI)*2,3686)/CALOGiO(REXn-l,5)**3 

CF=CFI/fC 

ST=CF*SH/2, 

RETURN 

END 





SUBROUTINE SNARFCXl , Y1 Z2f X3» Y3,Z3»Xil»Ya,Zil» AVX,AVY» AVZf 

lXNX,XNYrXNZ; AS,XO, YC, Z03 
DIMENSION XPAC«) ,YPAC4) , ZPA(«),. ;<ICa),ETA(«) 

XPA(l)=Xl 

VPACn=Yl 

ZPAtl}=Zl 

ZPA(2)=Z2 

YPA(2)=Y2 

XPA(2)=X2 

XPAC3)=X3 

YPA(3)=Y3 

ZPA(3)=Z3 

ZPAC4)=Z4 

YPAC4)SY4 

XPA(4)=X4 

TIX=X3-X1 

T1Y = Y3-*YI 

T1Z5Z3-Z1 

T2X=X4-X2 

T2Y=:Y4-Y2 

T2Z=Z4-Z2 

XNX=T2Y*TiZ-TlY*T2Z 
XNY=T1X*T2Z-T2X*T1Z 
XNZ=T2X*T1 Y"TIX*T2Y 
VN-SQKTCXNX**2+XNY**2+XNZ**2) 

XNX-XNX/VN 

XNY=XNY/VN 

XNZ=XNZ/VN 

DSXNX*CAVX-Xl) + XNY*(AVY-Yn + XNZ*CAVZ-'ZU 
POaABSCD) 

TaSQRTCTlXATlX + TlYATlY + TU*TlZ) 

nx=Tix/T 

TIY=T1YZT 

nz=Tiz/T 

T2X = XNY*nZ-XNZ*TlY 

T2Y=XNZATiX-XNX*TlZ 

T2zsxNx*ny^xNY*Tix 

DO 1000 J=W4 

XPACJ)=XPA(J)+XNX*D 

YPA(J)=YPACJ)+XNY*D 

ZPA(J)aZPACJ)+XNZ*D 

DastQ 

XDIF=XPACJ)-^AVX 

Y0IF=YPACJ)-AVY 

ZDIF=ZPA(J)-AVZ 

XI(J)=T1X*XDIF+T1Y*YDIF+T1Z*ZDIF 
1000 tTA(J)=T2X*X0lF+T2Y*YDIF+T2Z*Z0lF 

XIQ=(XI C4)*tETAn)-ETA(2))4-XI(2J*CETA(4)^ETACl)))/CETAC2D-£TAC/^3) 

1/3, 

ETAO=-ETACn/3, 

DO 1020 J=lr4 

xi(j;=xi(J)-xio 

1020 ETACJ)=ETA( J)-ETA0 

XO=AVX+T1X*XIO+T2X*ETAO 
YO=AVY-l'TiY*XlO+T2Y*ETAQ 
ZOaAVZ+TlZ*XIO+T2Z*ETAO 
ASa(£TA C2)-ETA(i})0* CXI C33-XH 1)3/2. 



SUBRUUTIMfc LTHMCXWYlr r X2# Y2, Z2# X3, Y3 , 23, xa, Y4 , PI , P2, P3, r 

1 Ql , Q2 f a3 , O'; , O.'U , RH2 , RH3 , RH« , R 1 , R2 , S3 , ^ i / W2 , v; 3 , W4 , 

2TH1, THHf. TH3/TH4, ALPDUM,XKl,XKa,XK3,XK4,XXTHX,XYLFT,XXM0M,CF,ST,LH) 
CQMMO^/i-TM/XSHFT , YSHF T , DUMA , DUMB, DUMC , DUM 1 , DUM2 , OUM3 , DUM4 
CDMMaN/.ETX/XJ,XJl,NPTS, 10, IREFL, ICHEM, IPUI^CH, IDESGN, IR, NXX, XBP, 
iYBP,THBP,RAO,XBDD,YBOD,THBOD,HADB,XEND, THEND,RTH,YEXn,THST,TEST, 
ilRFL,YO,RADB2,RRAD(20) , NSTAR, VND2, EIN, PEN,H16,H17 
COMMONAPEF/PriNF 
COMMON/.VISF/XVTHX, YVLFT, XVMOM 
C0MM0N/.IEQ/IEQ,PH^,RHDIMF,UINF,PINF 

C0MM0N/.HQT/AHC3) ,BH(3) ,CHC3) ,XSTR,PR,REC,REIN,RT,SH, ITrIViS 
DIMENSION AtPDUM(tO) 

P5XKl*Pi+XK2*P2+XK3*P3+XK4*P4 
Q:;XKUQt + XK2*Q2 + XK3*03 + XK4*Q4 
R=XKl*RlfXK2*R2+XK3*R3+XKa*R« 

WsXKl*rtl +XK 2 ^W 2 + XK 3 *VJ 3 + XK 4 *tv 4 

RHsXKi*RHl+XK2*RH2+XK3*RH3+XK4*RHa 

THsXKl*THl+XK2*TH2+XK3*TH3+XK4*Tha 

AVX=XKl*Xl+XK2*X2+XK3*X3+XK4*Xa 

AVY»XKl*Yl+XK2*Y2+XK3*Y3tXK4*Y4 


AVZsXK1*ZH‘XK2*Z2 + XK3*Z3 + XK4*Z4 

CALL SNARF(X1,Y1,21, X2, Y2,Z2,X3, Y3,Z3,X4,Y4,Z4,AVX,AVY,AVZ,XNX, 
IXNYfXNZ, ASSrXD, YO,ZO) 

CF = 0, 

IFaVIS,EQ,nCAUL GNURE{RH,D,P,^i,R, ALPDUM,XO,XBP,CF,ST,LHD 
IFCIVIS.EQ.nCALU GNUREIRH, Q,P, T,R, XO, XBP,CF,ST,LH) 

RHQsRH*Q*Q/2, 

PAV=(P/.PIN-1 , )*PINF*2116. 

Oxthx=-pav*xnx*ass 

DYLFT=-PAY*XNY*ASS 
X N Z Z = I 

IF(LH,EQ.3)XNZZ=XNZ 

DXTHXV=”CF*PFINF*XNZZ*C0S(TH)*ASS*RHQ 
DYLFTV = CF*PFINF*SINCTH) ?fASS*RHQ 
XMS=:XO-XSHF f 
YMS=YO-*YSHFT 

DMOMV=YMS*DXTHXV*XMS*DYLFTV 

XVTHXsXVTHX+DXTHXV 

YVLFTsYVLFT+DYLFTV 

XVMOMcXVMDM+DMOMV 

DXTHX=OXTHX+DXTHXV 

dylft=dylft+oylftv 

DMDMsYMS*OXTHX-XMS*DYLFT 

XXTHX=XXTHX+DXTHX 

XYLFT=XYLFT+DYLFT 

KXMOMsXXMUM+DMOM 


RETURN 

END 
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